diff --git a/NEWS.md b/NEWS.md index 2deb698..8ca96ff 100644 --- a/NEWS.md +++ b/NEWS.md @@ -37,8 +37,29 @@ statement-type and entity-type vocabularies, value ranges, `NA` statistics on nodes that are not in the input data, and that every edge's source and target are nodes. It stops with an error listing every problem found. +* `cytoscapeNetwork()` draws the node status columns. Nodes not in the +input data (`measured = FALSE`) have no fill and a dashed grey border, and +the legend lists them as "not in input data"; nodes with +`included_in_query = FALSE` are faded; nodes with an `NA` `logFC` have no +fill. `entity_type` sets the node shape: hexagon for metabolites and lipids, +diamond for drugs, octagon for complexes, barrel for families. The legend +shows only the node styles, shapes, and edge types present, and covers +every statement type of the contract. + ## Breaking changes +* `cytoscapeNetwork()` reads the edge `directed` column: an undirected edge +has no arrow and is drawn once for both directions, even when the reverse +edge is missing. Edges without the column treat `Complex` and +`Association` as undirected. Previously a `Complex` edge without its +reverse was drawn as directed. +* `cytoscapeNetwork()` colours a protein with PTM `site` rows from its +row with no `site`. A protein with only site rows is drawn as an uncoloured +container, and its site nodes keep their own colours. Previously it took +the colour of its first row, often a site's fold change. +* `cytoscapeNetwork()` no longer draws an `NA` `logFC` as the grey of a +zero fold change. + * The edges returned by `getSubnetworkFromIndra()` follow the edge contract. Columns are renamed, with no aliases: `stmt_hash` to `statement_id` (now always character, taken from INDRA's full-precision `matches_hash`), diff --git a/R/cytoscapeNetwork.R b/R/cytoscapeNetwork.R index c9e8925..a333020 100644 --- a/R/cytoscapeNetwork.R +++ b/R/cytoscapeNetwork.R @@ -10,10 +10,23 @@ #' columns: \code{logFC} (numeric), \code{entity_name} #' (character; may be semicolon-joined for multi-grounded #' rows), \code{entity_id} (character), \code{site} -#' (character, underscore-separated PTM site list). +#' (character, underscore-separated PTM site list), and +#' the node status columns of \code{\link{validate_network}()}: +#' \code{entity_type} sets the node shape (e.g. a hexagon +#' for \code{"metabolite"}); \code{measured = FALSE} draws a +#' node with no fill and a dashed grey border ("not in input +#' data"); \code{included_in_query = FALSE} fades it. A node +#' with an \code{NA} \code{logFC} has no fill. A protein +#' with \code{site} rows takes its colour from its row +#' with no \code{site}; without one, only its sites are +#' coloured. Missing status columns count as \code{TRUE}. #' @param edges Data frame with columns \code{source}, \code{target}, -#' \code{interaction}. Optional: \code{site}, -#' \code{evidence_url}, opened when an edge is clicked. +#' \code{interaction}. Optional: \code{directed} (an +#' edge with \code{FALSE} has no arrow and is drawn once +#' for both directions; without the column, \code{Complex} +#' and \code{Association} edges are undirected), +#' \code{site}, \code{evidence_url}, opened when an edge is +#' clicked. #' @param displayLabelType \code{"id"} (default) or \code{"entity_name"}: #' which column is used as the visible node label. #' \code{"entityName"} is deprecated and is treated as diff --git a/R/utils_cytoscapeNetwork.R b/R/utils_cytoscapeNetwork.R index 0d8b601..3950afc 100644 --- a/R/utils_cytoscapeNetwork.R +++ b/R/utils_cytoscapeNetwork.R @@ -1,13 +1,45 @@ +#' Node fill for a logFC of zero, and for nodes when there is no logFC column +#' @keywords internal +#' @noRd +NEUTRAL_NODE_COLOR <- "#D3D3D3" + +#' Node fill for an NA logFC: distinct from the zero-fold-change grey +#' @keywords internal +#' @noRd +NO_DATA_NODE_COLOR <- "#FFFFFF" + +#' Node shape for each nodes$entity_type +#' +#' Types that are not listed, and NA, get the protein shape. A PTM protein's +#' rows can be ptm_site rows; the protein node still gets the protein shape. +#' @keywords internal +#' @noRd +NODE_SHAPES <- c(protein = "round-rectangle", + gene = "round-rectangle", + transcript = "round-rectangle", + ptm_site = "round-rectangle", + metabolite = "hexagon", + lipid = "hexagon", + drug = "diamond", + complex = "octagon", + family = "barrel", + other = "round-rectangle") + #' Map logFC values to a blue-grey-red colour palette +#' +#' \code{NA} maps to \code{NO_DATA_NODE_COLOR}, not to the grey of a zero +#' fold change. #' @importFrom grDevices colorRamp rgb #' @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))) + colors <- c("#ADD8E6", "#ADD8E6", NEUTRAL_NODE_COLOR, "#FFA590", "#FFA590") + is_missing <- is.na(logFC_values) + result <- rep(NO_DATA_NODE_COLOR, length(logFC_values)) + + if (length(unique(logFC_values[!is_missing])) <= 1) { + result[!is_missing] <- NEUTRAL_NODE_COLOR + return(result) } is_pos_inf <- is.infinite(logFC_values) & logFC_values > 0 @@ -22,11 +54,56 @@ logFC_values[is_neg_inf] <- min_logFC color_map <- grDevices::colorRamp(colors) - normalized <- (logFC_values - min_logFC) / (max_logFC - min_logFC) - normalized[is.na(normalized)] <- 0.5 + normalized <- (logFC_values[!is_missing] - min_logFC) / + (max_logFC - min_logFC) rgb_colors <- color_map(normalized) - grDevices::rgb(rgb_colors[, 1], rgb_colors[, 2], rgb_colors[, 3], - maxColorValue = 255) + result[!is_missing] <- grDevices::rgb(rgb_colors[, 1], rgb_colors[, 2], + rgb_colors[, 3], maxColorValue = 255) + result +} + +#' How a node is drawn, from the node status columns +#' +#' \describe{ +#' \item{latent}{\code{measured = FALSE}: not in the input data} +#' \item{no_logfc}{in the input, but \code{logFC} is \code{NA}, e.g. a +#' node that matches the rows of several nodes} +#' \item{not_queried}{in the input, but \code{included_in_query = FALSE}} +#' \item{measured}{everything else} +#' } +#' A missing \code{measured} or \code{included_in_query} column counts as +#' \code{TRUE}, and a missing \code{logFC} column gives no +#' \code{"no_logfc"} rows, so nodes built by hand render as before. +#' \code{.buildElements()} adds \code{"sites_only"} for a PTM protein that +#' has no protein-level row. +#' @param nodes nodes data.frame +#' @return character vector, one status per row +#' @keywords internal +#' @noRd +.node_display_status <- function(nodes) { + measured <- .get_column_or_default(nodes, "measured", TRUE) %in% + c(TRUE, NA) + in_query <- .get_column_or_default(nodes, "included_in_query", TRUE) %in% + c(TRUE, NA) + no_logfc <- if ("logFC" %in% names(nodes)) { + is.na(nodes$logFC) + } else { + rep(FALSE, nrow(nodes)) + } + ifelse(!measured, "latent", + ifelse(no_logfc, "no_logfc", + ifelse(!in_query, "not_queried", "measured"))) +} + +#' Node shape for each entity type +#' @param entity_types character vector of nodes$entity_type values +#' @return character vector of Cytoscape shape names +#' @keywords internal +#' @noRd +.node_shape <- function(entity_types) { + shapes <- unname(NODE_SHAPES[as.character(entity_types)]) + shapes[is.na(shapes)] <- NODE_SHAPES[["protein"]] + shapes } #' Safely escape a string for embedding in a JS single-quoted literal @@ -43,43 +120,66 @@ } #' Relationship properties lookup +#' +#' Each statement type in \code{INTERACTION_TYPES} belongs to one category. +#' Whether an edge has an arrow comes from its \code{directed} column, not +#' from the category. #' @keywords internal #' @noRd .relProps <- function() { list( complex = list( - types = "Complex", - color = "#8B4513", + types = c("Complex", "Association"), + colors = list(Complex = "#8B4513", + Association = "#C08A5B"), style = "solid", arrow = "none", - width = 4, - consolidate = "undirected" + width = 4 ), regulatory = list( - types = c("Inhibition", "Activation", "IncreaseAmount", "DecreaseAmount"), + types = c("Inhibition", "Activation", "IncreaseAmount", + "DecreaseAmount", "Regulation", "Influence", + "Gef", "Gap", "GtpActivation"), colors = list(Inhibition = "#FF4444", Activation = "#44AA44", IncreaseAmount = "#4488FF", DecreaseAmount = "#FF8844"), style = "solid", arrow = "triangle", - width = 3, - consolidate = "directed" + width = 3 ), phosphorylation = list( - types = "Phosphorylation", + types = c("Phosphorylation", "Dephosphorylation", + "Autophosphorylation", "Transphosphorylation"), color = "#9932CC", style = "dashed", arrow = "triangle", - width = 2, - consolidate = "directed" + width = 2 + ), + modification = list( + types = c("Modification", + "Ubiquitination", "Deubiquitination", + "Sumoylation", "Desumoylation", + "Hydroxylation", "Dehydroxylation", + "Acetylation", "Deacetylation", + "Glycosylation", "Deglycosylation", + "Farnesylation", "Defarnesylation", + "Geranylgeranylation", "Degeranylgeranylation", + "Palmitoylation", "Depalmitoylation", + "Myristoylation", "Demyristoylation", + "Ribosylation", "Deribosylation", + "Methylation", "Demethylation"), + color = "#20898B", + style = "dashed", + arrow = "triangle", + width = 2 ), other = list( + types = c("Conversion", "Translocation"), color = "#666666", style = "dotted", arrow = "triangle", - width = 2, - consolidate = "directed" + width = 2 ) ) } @@ -109,7 +209,7 @@ props <- .relProps() p <- if (category %in% names(props)) props[[category]] else props$other - color <- if (category == "regulatory" && !is.null(p$colors)) { + color <- if (!is.null(p$colors)) { if (interaction %in% names(p$colors)) p$colors[[interaction]] else "#666666" } else { p$color @@ -168,84 +268,100 @@ result } +#' Whether each edge is directed +#' +#' Reads the contract's \code{directed} column. Edges without it, or with +#' \code{NA}, are undirected when their statement type is in +#' \code{UNDIRECTED_INTERACTION_TYPES}. +#' @param edges edges data.frame +#' @return logical vector, one per edge +#' @keywords internal +#' @noRd +.edge_is_directed <- function(edges) { + by_type <- !edges$interaction %in% UNDIRECTED_INTERACTION_TYPES + if (!"directed" %in% names(edges)) { + return(by_type) + } + directed <- as.logical(edges$directed) + ifelse(is.na(directed), by_type, directed) +} + #' Consolidate undirected edges +#' +#' An undirected edge is drawn without an arrow, and its reverse (same +#' statement type, endpoints swapped) is dropped, so the pair is drawn once. #' @keywords internal #' @noRd .consolidateEdges <- function(edges, nodes = NULL) { if (nrow(edges) == 0) return(edges) ptm_map <- .ptmOverlap(edges, nodes) - props <- .relProps() + directed <- .edge_is_directed(edges) 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 + edge_key <- paste(e$source, e$target, e$interaction, sep = "-") + ptm_txt <- if (edge_key %in% names(ptm_map)) ptm_map[[edge_key]] else "" + e$category <- .classify(e$interaction) + e$ptm_overlap <- ptm_txt - 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 == "undirected") { - new_edge <- data.frame(source = e$source, - target = e$target, - interaction = e$interaction, - edge_type = "undirected", - 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, e$interaction, sep = "-") - consolidated[[key]] <- new_edge - processed <- c(processed, pair_key) + if (directed[i]) { + e$edge_type <- "directed" } 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 + pair_key <- paste(c(sort(c(e$source, e$target)), e$interaction), + collapse = "-") + if (pair_key %in% processed) next + processed <- c(processed, pair_key) + e$edge_type <- "undirected" } + consolidated[[edge_key]] <- e } - if (length(consolidated) > 0) { - result <- do.call(rbind, consolidated) - rownames(result) <- NULL - result - } else { - edges[0, ] - } + result <- do.call(rbind, consolidated) + rownames(result) <- NULL + result } #' Build the list of Cytoscape element objects (nodes + edges) #' #' Returns a list of named lists — jsonlite will serialise them cleanly. +#' Node data carry \code{status} (\code{.node_display_status()}, plus +#' \code{"sites_only"}) and \code{shape}, which the widget styles and the +#' legend lists. A protein with PTM site rows takes its colour and status from +#' its protein-level row (\code{site} empty); without one it is +#' \code{"sites_only"} and only its site nodes are coloured. #' @keywords internal #' @noRd .buildElements <- function(nodes, edges, display_label_type = "id") { - # ── node colours ────────────────────────────────────────────────────── + # ── node colours, status, shape ─────────────────────────────────────── node_colors <- if ("logFC" %in% names(nodes)) { .mapLogFCToColor(nodes$logFC) } else { - rep("#D3D3D3", nrow(nodes)) + rep(NEUTRAL_NODE_COLOR, nrow(nodes)) } + node_status <- .node_display_status(nodes) + node_shapes <- .node_shape(.get_column_or_default(nodes, "entity_type", + NA_character_)) label_col <- if (display_label_type == "entity_name" && "entity_name" %in% names(nodes)) "entity_name" else "id" - has_ptm_sites <- if ("site" %in% names(nodes)) { - unique(nodes$id[!is.na(nodes$site) & trimws(nodes$site) != ""]) + is_site_row <- if ("site" %in% names(nodes)) { + !is.na(nodes$site) & trimws(nodes$site) != "" } else { - character(0) + rep(FALSE, nrow(nodes)) } + has_ptm_sites <- unique(nodes$id[is_site_row]) + + # The row a protein node is drawn from: its first protein-level row, + # else its first row + protein_level_rows <- which(!is_site_row) + protein_row <- protein_level_rows[match(nodes$id, + nodes$id[protein_level_rows])] + has_protein_row <- !is.na(protein_row) + protein_row[!has_protein_row] <- match(nodes$id, nodes$id)[!has_protein_row] elements <- list() emitted_prots <- character(0) @@ -256,12 +372,7 @@ 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 == "entity_name" && - !is.na(row$entity_name) && row$entity_name != "") - row$entity_name else row$id + has_site <- is_site_row[i] needs_compound <- row$id %in% has_ptm_sites compound_id <- paste0(row$id, "__compound__") @@ -277,9 +388,25 @@ # Protein node if (!(row$id %in% emitted_prots)) { + j <- protein_row[i] + protein_color <- node_colors[j] + protein_status <- node_status[j] + if (!has_protein_row[i] && protein_status != "latent") { + protein_color <- NO_DATA_NODE_COLOR + protein_status <- "sites_only" + } + display_label <- if (label_col == "entity_name" && + !is.na(nodes$entity_name[j]) && + nodes$entity_name[j] != "") + nodes$entity_name[j] else row$id nd <- list(id = row$id, label = display_label, - color = color, + color = protein_color, + status = protein_status, + shape = node_shapes[j], + entity_type = if ("entity_type" %in% names(nodes) && + !is.na(nodes$entity_type[j])) + nodes$entity_type[j] else "", node_type = "protein", width = max(60, min(nchar(display_label) * 8 + 20, 150)), height = max(40, min(nchar(display_label) * 2 + 30, 60))) @@ -300,6 +427,7 @@ id = ptm_nid, label = site, color = color, + status = node_status[i], parent_protein = row$id, parent = compound_id, node_type = "ptm" diff --git a/inst/htmlwidgets/cytoscapeNetwork.js b/inst/htmlwidgets/cytoscapeNetwork.js index a730e84..18ac223 100644 --- a/inst/htmlwidgets/cytoscapeNetwork.js +++ b/inst/htmlwidgets/cytoscapeNetwork.js @@ -9,7 +9,8 @@ The `x` object passed from R (via createWidget / jsonlite serialisation): { - nodes : [ { id, label, color, node_type, parent?, parent_protein? }, … ], + nodes : [ { id, label, color, node_type, status, shape?, + entity_type?, parent?, parent_protein? }, … ], edges : [ { source, target, id, interaction, edge_type, category, color, line_style, arrow_shape, width, tooltip, evidence_url? }, … ], @@ -50,7 +51,7 @@ HTMLWidgets.widget({ style: { "background-color": "data(color)", "label": "data(label)", - "shape": "round-rectangle", + "shape": "data(shape)", "font-size": (nodeFontSize || 12) + "px", "font-weight": "bold", "color": "#000", @@ -86,6 +87,33 @@ HTMLWidgets.widget({ "text-max-width": "18px" } }, + /* ── node status (see .node_display_status in R) ───────────────── */ + { + /* not in the input data: no fill, dashed grey border */ + selector: "node[status = 'latent']", + style: { + "background-opacity": 0, + "border-style": "dashed", + "border-color": "#999", + "color": "#555" + } + }, + { + /* in the input, but no logFC to colour by: no fill, solid border */ + selector: "node[status = 'sites_only'], node[status = 'no_logfc']", + style: { + "background-opacity": 0, + "border-style": "solid" + } + }, + { + /* in the input, but not part of the query: faded */ + selector: "node[status = 'not_queried']", + style: { + "background-opacity": 0.4, + "border-opacity": 0.5 + } + }, /* ── invisible compound containers ──────────────────────────── */ { selector: "node[node_type = 'compound']", @@ -197,35 +225,105 @@ HTMLWidgets.widget({ }); } + /* helper - escape text for the legend's innerHTML */ + function escapeHtml(text) { + return String(text) + .replace(/&/g, "&").replace(//g, ">").replace(/"/g, """); + } + + /* helper - small SVG of a Cytoscape node shape for the legend */ + function shapeIcon(shape) { + var body; + switch (shape) { + case "hexagon": + body = ''; break; + case "diamond": + body = ''; break; + case "octagon": + body = ''; break; + case "barrel": + body = ''; break; + default: + body = ''; + } + return '' + body + ''; + } + + /* helper - one legend row: a swatch followed by a label */ + function legendRow(swatchHtml, label) { + return '
' + + swatchHtml + '' + escapeHtml(label) + '
'; + } + + /* helper - legend heading */ + function legendHeading(text) { + return '
' + + text + '
'; + } + /* 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 = {}; + /* Edge types: one entry per statement type drawn, styled as drawn */ + var edgeTypes = {}; cyInstance.edges().forEach(function (e) { - var raw = e.data("interaction") || ""; - existingTypes[raw] = true; + if (e.data("edge_type") === "ptm_attachment") return; + var type = e.data("interaction") || ""; + if (!type || edgeTypes[type]) return; + edgeTypes[type] = { color: e.data("color"), style: e.data("line_style") }; }); - - var edgeItems = edgeTypeConfigs - .filter(function (c) { return existingTypes[c.type]; }) + var edgeItems = Object.keys(edgeTypes).sort().map(function (type) { + var c = edgeTypes[type]; + var line = (c.style === "dashed" || c.style === "dotted") + ? "border-top:2px " + c.style + " " + c.color + ";" + : "background-color:" + c.color + ";"; + return legendRow( + '
', + type.replace(/([a-z])([A-Z])/g, "$1 $2")); + }).join(""); + + /* Node status: only the statuses present, worded relative to the input */ + var statusConfigs = [ + { status: "latent", label: "not in input data", + box: "border:2px dashed #999;background:transparent;" }, + { status: "sites_only", label: "no protein-level row in input", + box: "border:2px solid #333;background:transparent;" }, + { status: "no_logfc", label: "in input, no logFC shown", + box: "border:2px solid #333;background:transparent;" }, + { status: "not_queried", label: "in input, not in query", + box: "border:2px solid rgba(51,51,51,.5);background:rgba(255,165,144,.4);" } + ]; + var statuses = {}; + cyInstance.nodes().forEach(function (n) { + if (n.data("status")) statuses[n.data("status")] = true; + }); + var statusItems = statusConfigs + .filter(function (c) { return statuses[c.status]; }) .map(function (c) { - var dash = c.dash ? "border-top: 2px dashed " + c.color + ";" : "background-color:" + c.color + ";"; - return '
' + - '
' + - '' + c.label + '
'; + return legendRow( + '
', c.label); }) .join(""); + /* Node shape: listed when the network has more than one shape */ + var shapeTypes = {}; + cyInstance.nodes('[node_type = "protein"]').forEach(function (n) { + var shape = n.data("shape") || "round-rectangle"; + var type = n.data("entity_type") || ""; + if (type === "ptm_site") type = "protein"; + shapeTypes[shape] = shapeTypes[shape] || {}; + if (type) shapeTypes[shape][type] = true; + }); + var shapes = Object.keys(shapeTypes); + var shapeItems = shapes.length < 2 ? "" : shapes.map(function (shape) { + var types = Object.keys(shapeTypes[shape]).sort(); + return legendRow(shapeIcon(shape), types.length ? types.join(", ") : "other"); + }).join(""); + var hasPtm = cyInstance.nodes('[node_type = "ptm"]').length > 0; legendEl.innerHTML = @@ -235,7 +333,9 @@ HTMLWidgets.widget({ '
' + ' UpregulatedNeutralDownregulated' + '
' + - (edgeItems ? '
Edge types
' + edgeItems : '') + + statusItems + + (shapeItems ? legendHeading("Node shape") + shapeItems : '') + + (edgeItems ? legendHeading("Edge types") + edgeItems : '') + (hasPtm ? '
' + 'PTM info: Hover over edges to see overlapping PTM sites.
' diff --git a/man/cytoscapeNetwork.Rd b/man/cytoscapeNetwork.Rd index d305765..e257f9e 100644 --- a/man/cytoscapeNetwork.Rd +++ b/man/cytoscapeNetwork.Rd @@ -20,11 +20,24 @@ cytoscapeNetwork( columns: \code{logFC} (numeric), \code{entity_name} (character; may be semicolon-joined for multi-grounded rows), \code{entity_id} (character), \code{site} -(character, underscore-separated PTM site list).} +(character, underscore-separated PTM site list), and +the node status columns of \code{\link{validate_network}()}: +\code{entity_type} sets the node shape (e.g. a hexagon +for \code{"metabolite"}); \code{measured = FALSE} draws a +node with no fill and a dashed grey border ("not in input +data"); \code{included_in_query = FALSE} fades it. A node +with an \code{NA} \code{logFC} has no fill. A protein +with \code{site} rows takes its colour from its row +with no \code{site}; without one, only its sites are +coloured. Missing status columns count as \code{TRUE}.} \item{edges}{Data frame with columns \code{source}, \code{target}, -\code{interaction}. Optional: \code{site}, -\code{evidence_url}, opened when an edge is clicked.} +\code{interaction}. Optional: \code{directed} (an +edge with \code{FALSE} has no arrow and is drawn once +for both directions; without the column, \code{Complex} +and \code{Association} edges are undirected), +\code{site}, \code{evidence_url}, opened when an edge is +clicked.} \item{displayLabelType}{\code{"id"} (default) or \code{"entity_name"}: which column is used as the visible node label. diff --git a/man/exportNetworkToHTML.Rd b/man/exportNetworkToHTML.Rd index 44fd42d..9b0b72f 100644 --- a/man/exportNetworkToHTML.Rd +++ b/man/exportNetworkToHTML.Rd @@ -18,11 +18,24 @@ exportNetworkToHTML( columns: \code{logFC} (numeric), \code{entity_name} (character; may be semicolon-joined for multi-grounded rows), \code{entity_id} (character), \code{site} -(character, underscore-separated PTM site list).} +(character, underscore-separated PTM site list), and +the node status columns of \code{\link{validate_network}()}: +\code{entity_type} sets the node shape (e.g. a hexagon +for \code{"metabolite"}); \code{measured = FALSE} draws a +node with no fill and a dashed grey border ("not in input +data"); \code{included_in_query = FALSE} fades it. A node +with an \code{NA} \code{logFC} has no fill. A protein +with \code{site} rows takes its colour from its row +with no \code{site}; without one, only its sites are +coloured. Missing status columns count as \code{TRUE}.} \item{edges}{Data frame with columns \code{source}, \code{target}, -\code{interaction}. Optional: \code{site}, -\code{evidence_url}, opened when an edge is clicked.} +\code{interaction}. Optional: \code{directed} (an +edge with \code{FALSE} has no arrow and is drawn once +for both directions; without the column, \code{Complex} +and \code{Association} edges are undirected), +\code{site}, \code{evidence_url}, opened when an edge is +clicked.} \item{filename}{Output HTML filename} diff --git a/man/previewNetworkInBrowser.Rd b/man/previewNetworkInBrowser.Rd index 45a133c..6bb599f 100644 --- a/man/previewNetworkInBrowser.Rd +++ b/man/previewNetworkInBrowser.Rd @@ -16,11 +16,24 @@ previewNetworkInBrowser( columns: \code{logFC} (numeric), \code{entity_name} (character; may be semicolon-joined for multi-grounded rows), \code{entity_id} (character), \code{site} -(character, underscore-separated PTM site list).} +(character, underscore-separated PTM site list), and +the node status columns of \code{\link{validate_network}()}: +\code{entity_type} sets the node shape (e.g. a hexagon +for \code{"metabolite"}); \code{measured = FALSE} draws a +node with no fill and a dashed grey border ("not in input +data"); \code{included_in_query = FALSE} fades it. A node +with an \code{NA} \code{logFC} has no fill. A protein +with \code{site} rows takes its colour from its row +with no \code{site}; without one, only its sites are +coloured. Missing status columns count as \code{TRUE}.} \item{edges}{Data frame with columns \code{source}, \code{target}, -\code{interaction}. Optional: \code{site}, -\code{evidence_url}, opened when an edge is clicked.} +\code{interaction}. Optional: \code{directed} (an +edge with \code{FALSE} has no arrow and is drawn once +for both directions; without the column, \code{Complex} +and \code{Association} edges are undirected), +\code{site}, \code{evidence_url}, opened when an edge is +clicked.} \item{displayLabelType}{\code{"id"} (default) or \code{"entity_name"}: which column is used as the visible node label. diff --git a/tests/testthat/test-utils_cytoscapeNetwork.R b/tests/testthat/test-utils_cytoscapeNetwork.R index 0b84cc8..dcddb08 100644 --- a/tests/testthat/test-utils_cytoscapeNetwork.R +++ b/tests/testthat/test-utils_cytoscapeNetwork.R @@ -52,10 +52,26 @@ test_that(".mapLogFCToColor returns valid hex colours", { expect_true(all(grepl("^#[0-9A-Fa-f]{6}$", colors))) }) -test_that(".mapLogFCToColor returns grey for all-NA input", { +test_that(".mapLogFCToColor returns the no-data colour for all-NA input", { colors <- MSstatsBioNet:::.mapLogFCToColor(c(NA, NA, NA)) expect_length(colors, 3) - expect_true(all(colors == "#D3D3D3")) + expect_true(all(colors == MSstatsBioNet:::NO_DATA_NODE_COLOR)) +}) + +test_that(".mapLogFCToColor gives NA a colour distinct from a zero fold change", { + colors <- MSstatsBioNet:::.mapLogFCToColor(c(-2, 0, NA, 2)) + expect_equal(colors[3], MSstatsBioNet:::NO_DATA_NODE_COLOR) + expect_equal(colors[2], MSstatsBioNet:::NEUTRAL_NODE_COLOR) + expect_false(MSstatsBioNet:::NO_DATA_NODE_COLOR == + MSstatsBioNet:::NEUTRAL_NODE_COLOR) + # NA does not shift the colours of the other values + expect_equal(colors[-3], MSstatsBioNet:::.mapLogFCToColor(c(-2, 0, 2))) +}) + +test_that(".mapLogFCToColor keeps NA distinct when one value is non-NA", { + colors <- MSstatsBioNet:::.mapLogFCToColor(c(1, NA)) + expect_equal(colors, c(MSstatsBioNet:::NEUTRAL_NODE_COLOR, + MSstatsBioNet:::NO_DATA_NODE_COLOR)) }) test_that(".mapLogFCToColor returns grey for all-identical values", { @@ -83,16 +99,20 @@ test_that(".relProps returns correct structure", { props <- MSstatsBioNet:::.relProps() expect_type(props, "list") - expect_true(all(c("complex", "regulatory", "phosphorylation", "other") %in% names(props))) - - expect_equal(props$complex$consolidate, "undirected") - expect_equal(props$regulatory$consolidate, "directed") - expect_equal(props$phosphorylation$consolidate, "directed") + expect_true(all(c("complex", "regulatory", "phosphorylation", + "modification", "other") %in% names(props))) expect_true("Inhibition" %in% names(props$regulatory$colors)) expect_true("Activation" %in% names(props$regulatory$colors)) }) +test_that(".relProps puts every contract statement type in exactly one category", { + props <- MSstatsBioNet:::.relProps() + listed <- unlist(lapply(props, `[[`, "types"), use.names = FALSE) + expect_setequal(listed, MSstatsBioNet:::INTERACTION_TYPES) + expect_false(anyDuplicated(listed) > 0) +}) + # ============================================================================= # .classify # ============================================================================= @@ -102,6 +122,10 @@ test_that(".classify maps interaction types to correct categories", { expect_equal(MSstatsBioNet:::.classify("Activation"), "regulatory") expect_equal(MSstatsBioNet:::.classify("Phosphorylation"), "phosphorylation") expect_equal(MSstatsBioNet:::.classify("Complex"), "complex") + expect_equal(MSstatsBioNet:::.classify("Association"), "complex") + expect_equal(MSstatsBioNet:::.classify("Dephosphorylation"), "phosphorylation") + expect_equal(MSstatsBioNet:::.classify("Ubiquitination"), "modification") + expect_equal(MSstatsBioNet:::.classify("Translocation"), "other") expect_equal(MSstatsBioNet:::.classify("Unknown"), "other") }) @@ -165,6 +189,43 @@ test_that(".consolidateEdges marks complex as undirected", { expect_equal(complex$edge_type, "undirected") }) +test_that(".consolidateEdges reads the directed column", { + edges <- data.frame(source = c("A", "B", "C"), + target = c("B", "A", "D"), + interaction = c("Activation", "Activation", "Complex"), + directed = c(FALSE, FALSE, TRUE), + stringsAsFactors = FALSE) + result <- MSstatsBioNet:::.consolidateEdges(edges) + # Undirected A-B pair is drawn once; a directed Complex keeps its arrow + expect_equal(nrow(result), 2) + expect_equal(result$edge_type[result$interaction == "Activation"], + "undirected") + expect_equal(result$edge_type[result$interaction == "Complex"], "directed") +}) + +test_that(".consolidateEdges falls back to the statement type without directed", { + edges <- data.frame(source = c("A", "C", "E"), + target = c("B", "D", "F"), + interaction = c("Complex", "Association", "Activation"), + stringsAsFactors = FALSE) + result <- MSstatsBioNet:::.consolidateEdges(edges) + # A Complex edge with no reverse edge is still undirected + expect_equal(result$edge_type, c("undirected", "undirected", "directed")) + + edges$directed <- c(NA, FALSE, NA) + expect_equal(MSstatsBioNet:::.consolidateEdges(edges)$edge_type, + c("undirected", "undirected", "directed")) +}) + +test_that(".consolidateEdges keeps undirected edges of different types", { + edges <- data.frame(source = c("A", "B"), + target = c("B", "A"), + interaction = c("Complex", "Association"), + stringsAsFactors = FALSE) + result <- MSstatsBioNet:::.consolidateEdges(edges) + expect_equal(nrow(result), 2) +}) + test_that(".consolidateEdges handles empty input", { empty <- data.frame(source = character(0), target = character(0), interaction = character(0), stringsAsFactors = FALSE) @@ -280,6 +341,127 @@ test_that(".buildElements uses grey when logFC column is absent", { expect_true(all(colors == "#D3D3D3")) }) +# Node data of the main (non-PTM, non-compound) nodes, keyed by id +.main_node_data <- function(elements) { + main <- Filter(function(el) identical(el$data$node_type, "protein"), + elements) + stats::setNames(lapply(main, `[[`, "data"), + vapply(main, function(el) el$data$id, character(1))) +} + +# A network with (a) a significant protein, (b) a protein in the input with +# logFC near 0 that was not queried, and (c) a protein not in the input +.node_status_fixture <- function() { + data.frame( + id = c("SIG", "FLAT", "LATENT"), + entity_type = "protein", + measured = c(TRUE, TRUE, FALSE), + included_in_query = c(TRUE, FALSE, TRUE), + logFC = c(2.5, 0.01, NA), + adj.pvalue = c(0.001, 0.9, NA), + stringsAsFactors = FALSE + ) +} + +test_that(".node_display_status distinguishes measured, not queried, and latent", { + status <- MSstatsBioNet:::.node_display_status(.node_status_fixture()) + expect_equal(status, c("measured", "not_queried", "latent")) +}) + +test_that(".node_display_status treats missing status columns as measured", { + nodes <- create_mock_nodes() + expect_true(all(MSstatsBioNet:::.node_display_status(nodes) == "measured")) + nodes$logFC[2] <- NA + expect_equal(MSstatsBioNet:::.node_display_status(nodes)[2], "no_logfc") + nodes$logFC <- NULL + expect_true(all(MSstatsBioNet:::.node_display_status(nodes) == "measured")) +}) + +test_that(".buildElements styles the node-status fixture three ways", { + nodes <- .main_node_data(MSstatsBioNet:::.buildElements( + .node_status_fixture(), data.frame())) + expect_equal(nodes$SIG$status, "measured") + expect_equal(nodes$FLAT$status, "not_queried") + expect_equal(nodes$LATENT$status, "latent") + expect_equal(nodes$LATENT$color, MSstatsBioNet:::NO_DATA_NODE_COLOR) + expect_false(nodes$FLAT$color == nodes$LATENT$color) +}) + +test_that(".buildElements colours a PTM protein from its protein-level row", { + nodes <- data.frame(id = c("P1", "P1", "P1"), + site = c("S5", NA, "T9"), + logFC = c(-2, 1.5, 2), + stringsAsFactors = FALSE) + elements <- MSstatsBioNet:::.buildElements(nodes, data.frame()) + protein <- .main_node_data(elements)$P1 + expected <- MSstatsBioNet:::.mapLogFCToColor(nodes$logFC) + expect_equal(protein$color, expected[2]) + expect_equal(protein$status, "measured") + ptm <- Filter(function(el) identical(el$data$node_type, "ptm"), elements) + ptm_colors <- vapply(ptm, function(el) el$data$color, character(1)) + names(ptm_colors) <- vapply(ptm, function(el) el$data$label, character(1)) + expect_equal(unname(ptm_colors[c("S5", "T9")]), expected[c(1, 3)]) +}) + +test_that(".buildElements draws a PTM protein without a protein-level row as a container", { + elements <- MSstatsBioNet:::.buildElements(create_mock_nodes_ptm(), + data.frame()) + mdm2 <- .main_node_data(elements)$MDM2_HUMAN + expect_equal(mdm2$status, "sites_only") + expect_equal(mdm2$color, MSstatsBioNet:::NO_DATA_NODE_COLOR) + # The site nodes keep the colour of their row + ptm <- Filter(function(el) identical(el$data$node_type, "ptm"), elements) + site_color <- MSstatsBioNet:::.mapLogFCToColor( + create_mock_nodes_ptm()$logFC)[2] + expect_true(all(vapply(ptm, function(el) el$data$color, character(1)) == + site_color)) + expect_true(all(vapply(ptm, function(el) el$data$status, character(1)) == + "measured")) +}) + +test_that(".buildElements gives nodes a shape by entity_type", { + nodes <- data.frame(id = c("P", "M", "D", "F", "X", "S"), + entity_type = c("protein", "metabolite", "drug", + "family", NA, "ptm_site"), + stringsAsFactors = FALSE) + data <- .main_node_data(MSstatsBioNet:::.buildElements(nodes, data.frame())) + shapes <- vapply(data, `[[`, character(1), "shape") + expect_equal(unname(shapes[c("P", "M", "D", "F", "X", "S")]), + c("round-rectangle", "hexagon", "diamond", "barrel", + "round-rectangle", "round-rectangle")) + expect_equal(data$X$entity_type, "") + expect_equal(data$M$entity_type, "metabolite") +}) + +test_that(".buildElements gives every node the protein shape without entity_type", { + data <- .main_node_data(MSstatsBioNet:::.buildElements(create_mock_nodes(), + data.frame())) + expect_true(all(vapply(data, `[[`, character(1), "shape") == + "round-rectangle")) +}) + +test_that("every ENTITY_TYPES value has a node shape", { + expect_setequal(names(MSstatsBioNet:::NODE_SHAPES), + MSstatsBioNet:::ENTITY_TYPES) +}) + +test_that(".buildElements draws undirected edges without an arrow", { + edges <- data.frame(source = c("P53_HUMAN", "MDM2_HUMAN"), + target = c("MDM2_HUMAN", "ATM_HUMAN"), + interaction = c("Association", "Activation"), + directed = c(FALSE, TRUE), + stringsAsFactors = FALSE) + elements <- MSstatsBioNet:::.buildElements(create_mock_nodes(), edges) + edge_data <- lapply(Filter(function(el) !is.null(el$data$source) && + !identical(el$data$edge_type, + "ptm_attachment"), + elements), `[[`, "data") + arrows <- vapply(edge_data, `[[`, character(1), "arrow_shape") + names(arrows) <- vapply(edge_data, `[[`, character(1), "interaction") + expect_equal(unname(arrows[c("Association", "Activation")]), + c("none", "triangle")) +}) + # ============================================================================= # cytoscapeNetwork() — public API # ============================================================================= diff --git a/vignettes/Cytoscape-Visualization.Rmd b/vignettes/Cytoscape-Visualization.Rmd index f205b65..64a6fe4 100644 --- a/vignettes/Cytoscape-Visualization.Rmd +++ b/vignettes/Cytoscape-Visualization.Rmd @@ -48,7 +48,9 @@ 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 +# clustered around the parent protein. Each site takes its row's colour; a +# protein is coloured only from a row with no `site` (here AKT1), so EGFR and +# SRC are drawn as uncoloured containers. Hover over edges to see overlap # information when an edge target shares a PTM site with node data. nodes_ptm <- data.frame( @@ -69,7 +71,33 @@ edges_ptm <- data.frame( cytoscapeNetwork(nodes_ptm, edges_ptm, nodeFontSize = 14) -# ── Example 4 · Entity labels + left-to-right layout ─────────────────────── +# ── Example 4 · Nodes outside the input, and node shapes ─────────────────── +# The node status columns from get_network() change how a node is drawn: +# measured = FALSE (not in the input data) has no fill and a dashed border, +# included_in_query = FALSE is faded, and entity_type sets the shape. +# Complex and Association edges have no arrow (the `directed` column). + +nodes_status <- data.frame( + id = c("TP53", "MDM2", "CDKN1A", "GLUCOSE"), + entity_type = c("protein", "protein", "protein", "metabolite"), + measured = c(TRUE, TRUE, FALSE, TRUE), + included_in_query = c(TRUE, FALSE, TRUE, TRUE), + logFC = c(1.8, 0.1, NA, -1.2), + stringsAsFactors = FALSE +) + +edges_status <- data.frame( + source = c("TP53", "TP53", "GLUCOSE"), + target = c("MDM2", "CDKN1A", "TP53"), + interaction = c("Complex", "IncreaseAmount", "Association"), + directed = c(FALSE, TRUE, FALSE), + stringsAsFactors = FALSE +) + +cytoscapeNetwork(nodes_status, edges_status) + + +# ── Example 5 · Entity labels + left-to-right layout ─────────────────────── nodes_entity <- data.frame( id = c("ENSG001", "ENSG002", "ENSG003"), @@ -92,7 +120,7 @@ cytoscapeNetwork( ) -# ── Example 5 · Evidence links ─────────────────────────────────────────────── +# ── Example 6 · Evidence links ─────────────────────────────────────────────── # Click an edge to open the evidence URL in a new tab. edges_ev <- data.frame( @@ -109,7 +137,7 @@ edges_ev <- data.frame( cytoscapeNetwork(nodes_min, edges_ev) -# ── Example 6 · Shiny integration ─────────────────────────────────────────── +# ── Example 7 · Shiny integration ─────────────────────────────────────────── if (requireNamespace("shiny", quietly = TRUE)) { library(shiny) ui <- fluidPage( @@ -142,7 +170,7 @@ if (requireNamespace("shiny", quietly = TRUE)) { -# ── Example 7 · Save to a standalone HTML file ────────────────────────────── +# ── Example 8 · Save to a standalone HTML file ────────────────────────────── widget <- cytoscapeNetwork(nodes_ptm, edges_ptm)