diff --git a/DESCRIPTION b/DESCRIPTION index 6e7b46a..d9a9558 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,7 +25,8 @@ Imports: r2r, tidyr, htmlwidgets, - grDevices + grDevices, + stats Suggests: data.table, BiocStyle, diff --git a/NAMESPACE b/NAMESPACE index e7df7ff..2667676 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,7 +4,6 @@ export(annotateProteinInfoFromIndra) export(cytoscapeNetwork) export(cytoscapeNetworkOutput) export(exportNetworkToHTML) -export(generateCytoscapeConfig) export(getSubnetworkFromIndra) export(previewNetworkInBrowser) export(renderCytoscapeNetwork) @@ -22,6 +21,8 @@ importFrom(RCy3,setVisualStyle) importFrom(grDevices,colorRamp) importFrom(grDevices,rgb) importFrom(htmlwidgets,createWidget) +importFrom(htmlwidgets,shinyRenderWidget) +importFrom(htmlwidgets,shinyWidgetOutput) importFrom(httr,GET) importFrom(httr,POST) importFrom(httr,add_headers) @@ -33,5 +34,6 @@ importFrom(r2r,hashmap) importFrom(r2r,keys) importFrom(r2r,query) importFrom(stats,cor) +importFrom(stats,setNames) importFrom(tidyr,pivot_wider) importFrom(utils,browseURL) diff --git a/R/cytoscapeNetwork.R b/R/cytoscapeNetwork.R index 149ca72..cc3a3e8 100644 --- a/R/cytoscapeNetwork.R +++ b/R/cytoscapeNetwork.R @@ -1,373 +1,3 @@ -# 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 @@ -422,83 +52,85 @@ cytoscapeNetwork <- function(nodes, 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 - ) + + # 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 +#' @importFrom htmlwidgets shinyWidgetOutput #' @inheritParams htmlwidgets::shinyWidgetOutput #' @export cytoscapeNetworkOutput <- function(outputId, width = "100%", height = "500px") { - htmlwidgets::shinyWidgetOutput( - outputId = outputId, - name = "cytoscapeNetwork", - width = width, - height = height, - package = "MSstatsBioNet" - ) + htmlwidgets::shinyWidgetOutput( + outputId = outputId, + name = "cytoscapeNetwork", + width = width, + height = height, + package = "MSstatsBioNet" + ) } #' Shiny render binding for cytoscapeNetwork +#' @importFrom htmlwidgets shinyRenderWidget createWidget #' @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 - ) + if (!quoted) expr <- substitute(expr) + htmlwidgets::shinyRenderWidget( + expr = expr, + outputFunction = cytoscapeNetworkOutput, + env = env, + quoted = TRUE + ) } diff --git a/R/exportNetworkToHTML.R b/R/exportNetworkToHTML.R new file mode 100644 index 0000000..c333cc4 --- /dev/null +++ b/R/exportNetworkToHTML.R @@ -0,0 +1,56 @@ +#' Export network data with Cytoscape visualization +#' +#' Convenience function that takes nodes and edges data directly and creates +#' both the configuration and HTML export in one step. +#' +#' @inheritParams cytoscapeNetwork +#' @param filename Output HTML filename +#' @param ... Additional arguments passed to exportCytoscapeToHTML() +#' @export +#' @return Invisibly returns the file path of the created HTML file +exportNetworkToHTML <- function(nodes, edges, + filename = "network_visualization.html", + displayLabelType = "id", + nodeFontSize = 12, + ...) { + + widget <- cytoscapeNetwork(nodes, edges, + displayLabelType = displayLabelType, + nodeFontSize = nodeFontSize) + + htmlwidgets::saveWidget( + widget, + file = filename, + selfcontained = TRUE + ) + + invisible(filename) +} + +#' Preview network in browser +#' +#' Creates a temporary HTML file and opens it in the default web browser +#' @export +#' @importFrom utils browseURL +#' @inheritParams exportNetworkToHTML +previewNetworkInBrowser <- function(nodes, edges, + displayLabelType = "id", + nodeFontSize = 12) { + + # Create temporary filename + temp_file <- tempfile(fileext = ".html") + + # Export to temp file + exportNetworkToHTML(nodes, edges, + filename = temp_file, + displayLabelType = displayLabelType, + nodeFontSize = nodeFontSize) + + # Open in browser + if (interactive()) { + browseURL(temp_file) + cat("Network opened in browser. Temporary file:", temp_file, "\n") + } + + invisible(temp_file) +} \ No newline at end of file diff --git a/R/utils_cytoscapeNetwork.R b/R/utils_cytoscapeNetwork.R new file mode 100644 index 0000000..3cbdf57 --- /dev/null +++ b/R/utils_cytoscapeNetwork.R @@ -0,0 +1,358 @@ +#' Map logFC values to a blue-grey-red colour palette +#' @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))) + } + + 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 +#' @importFrom stats setNames +#' @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 +} \ No newline at end of file diff --git a/R/utils_getSubnetworkFromIndra.R b/R/utils_getSubnetworkFromIndra.R index a5a717c..d540635 100644 --- a/R/utils_getSubnetworkFromIndra.R +++ b/R/utils_getSubnetworkFromIndra.R @@ -376,7 +376,7 @@ .filterByPtmSite = function(nodes, edges, filter_by_ptm_site) { if (filter_by_ptm_site && nrow(nodes[!is.na(nodes$Site), ]) > 0) { - ptm_overlap <- .calculatePTMOverlapAggregated(edges, nodes) + ptm_overlap <- .ptmOverlap(edges, nodes) keep <- ptm_overlap[paste(edges$source, edges$target, edges$interaction, sep = "-")] edges <- edges[!is.na(keep) & keep != "", ] edges <- edges[!is.na(edges$site),] diff --git a/R/visualizeNetworksWithHTML.R b/R/visualizeNetworksWithHTML.R deleted file mode 100644 index 7a2316d..0000000 --- a/R/visualizeNetworksWithHTML.R +++ /dev/null @@ -1,1380 +0,0 @@ -#' Helper function to map logFC values to colors -#' @param logFC_values Numeric vector of log fold change values -#' @importFrom grDevices colorRamp rgb -#' @noRd -mapLogFCToColor <- function(logFC_values) { - # Define the color palette - colors <- c("#ADD8E6", "#ADD8E6", "#D3D3D3", "#FFA590", "#FFA590") - - # Handle case where all values are the same or missing - if (all(is.na(logFC_values)) || length(unique(logFC_values[!is.na(logFC_values)])) <= 1) { - return(rep("#D3D3D3", length(logFC_values))) - } - - # Get range of logFC values - default_max <- 2 - max_logFC <- max(c(abs(logFC_values), default_max), na.rm = TRUE) - min_logFC <- -1 * max_logFC - - # Create color mapping function - color_map <- colorRamp(colors) - - # Normalize logFC values to [0, 1] range - normalized_values <- (logFC_values - min_logFC) / (max_logFC - min_logFC) - - # Handle NA values - normalized_values[is.na(normalized_values)] <- 0.5 # Default to middle color - - # Get RGB colors and convert to hex - rgb_colors <- color_map(normalized_values) - hex_colors <- rgb(rgb_colors[,1], rgb_colors[,2], rgb_colors[,3], maxColorValue = 255) - - return(hex_colors) -} - -# Define relationship categories and their properties -getRelationshipProperties <- function() { - list( - complex = list( - types = c("Complex"), - color = "#8B4513", # Brown - style = "solid", - arrow = "none", # Undirected - width = 4, - consolidate = "undirected" - ), - regulatory = list( - types = c("Inhibition", "Activation", "IncreaseAmount", "DecreaseAmount"), - colors = list( - "Inhibition" = "#FF4444", # Red - "Activation" = "#44AA44", # Green - "IncreaseAmount" = "#4488FF", # Blue - "DecreaseAmount" = "#FF8844" # Orange - ), - style = "solid", - arrow = "triangle", - width = 3, - consolidate = "bidirectional" - ), - phosphorylation = list( - types = c("Phosphorylation"), - color = "#9932CC", # Purple - style = "dashed", - arrow = "triangle", - width = 2, - consolidate = "directed" - ), - other = list( - color = "#666666", # Gray - style = "dotted", - arrow = "triangle", - width = 2, - consolidate = "directed" - ) - ) -} - -#' Calculate PTM site overlap between edge targets and nodes with aggregation -#' @param edges Data frame with edge information including 'target' and 'site' columns -#' @param nodes Data frame with node information including 'id' and 'Site' columns -#' @return Vector of overlap descriptions for each unique edge (after consolidation) -#' @keywords internal -#' @noRd -.calculatePTMOverlapAggregated <- function(edges, nodes) { - if (nrow(edges) == 0) return(character(0)) - - # Group edges by source-target-interaction to match consolidation logic - edges$edge_key <- paste(edges$source, edges$target, edges$interaction, sep = "-") - unique_edges <- unique(edges$edge_key) - - overlap_info <- character(length(unique_edges)) - names(overlap_info) <- unique_edges - - for (edge_key in unique_edges) { - # Get all edges with this source-target-interaction combination - matching_edges <- edges[edges$edge_key == edge_key, ] - all_overlap_sites <- c() - - # Process each matching edge to find PTM overlaps - for (i in 1:nrow(matching_edges)) { - edge <- matching_edges[i, ] - - # Check if edge has target and site information - if (!is.na(edge$target) && "site" %in% names(edge) && !is.na(edge$site)) { - # Find matching nodes with the same target ID - target_nodes <- nodes[nodes$id == edge$target, ] - - if (nrow(target_nodes) > 0 && "Site" %in% names(target_nodes)) { - edge_sites <- trimws(unlist(strsplit(as.character(edge$site), "[,;|]"))) - - # Check each target node row for site matches - for (j in 1:nrow(target_nodes)) { - if (!is.na(target_nodes$Site[j])) { - node_sites <- trimws(unlist(strsplit(as.character(target_nodes$Site[j]), "_"))) - - # Find overlapping sites for this edge-node combination - overlap_sites <- intersect(edge_sites, node_sites) - overlap_sites <- overlap_sites[overlap_sites != "" & !is.na(overlap_sites)] - - # Add to the aggregate list - all_overlap_sites <- c(all_overlap_sites, overlap_sites) - } - } - } - } - } - - # Remove duplicates and create tooltip text for this consolidated edge - unique_overlap_sites <- unique(all_overlap_sites) - unique_overlap_sites <- unique_overlap_sites[unique_overlap_sites != "" & !is.na(unique_overlap_sites)] - - if (length(unique_overlap_sites) > 0) { - if (length(unique_overlap_sites) == 1) { - overlap_info[edge_key] <- paste0("Overlapping PTM site: ", unique_overlap_sites[1]) - } else { - overlap_info[edge_key] <- paste0("Overlapping PTM sites: ", paste(unique_overlap_sites, collapse = ", ")) - } - } else { - overlap_info[edge_key] <- "" - } - } - - return(overlap_info) -} - -# Consolidate bidirectional edges based on relationship type -consolidateEdges <- function(edges, nodes = NULL) { - if (nrow(edges) == 0) return(edges) - - required_cols <- c("source", "target", "interaction") - missing_cols <- setdiff(required_cols, names(edges)) - if (length(missing_cols) > 0) { - stop("Missing required columns: ", paste(missing_cols, collapse = ", ")) - } - - # Calculate aggregated PTM overlap information if nodes are provided - ptm_overlap_map <- if (!is.null(nodes)) { - .calculatePTMOverlapAggregated(edges, nodes) - } else { - NULL - } - - relationship_props <- getRelationshipProperties() - consolidated_edges <- list() - processed_pairs <- c() - - for (i in 1:nrow(edges)) { - edge <- edges[i, ] - pair_key <- paste(sort(c(edge$source, edge$target)), edge$interaction, collapse = "-") - - # Skip if we've already processed this pair - if (pair_key %in% processed_pairs) next - - # Determine relationship category - interaction_type <- edge$interaction - category <- "other" - for (cat_name in names(relationship_props)) { - if (interaction_type %in% relationship_props[[cat_name]]$types) { - category <- cat_name - break - } - } - - # Find reverse edge if it exists - reverse_edges <- edges[edges$source == edge$target & - edges$target == edge$source & - edges$interaction == edge$interaction, ] - - consolidation_type <- relationship_props[[category]]$consolidate - - # Get PTM overlap info for this edge combination - edge_key <- paste(edge$source, edge$target, edge$interaction, sep = "-") - ptm_overlap_text <- if (!is.null(ptm_overlap_map) && edge_key %in% names(ptm_overlap_map)) { - ptm_overlap_map[[edge_key]] - } else { - "" - } - - if (nrow(reverse_edges) > 0 && consolidation_type %in% c("undirected", "bidirectional")) { - # Create consolidated edge - if (consolidation_type == "undirected") { - # For complex relationships - create undirected edge - consolidated_edge <- data.frame( - source = edge$source, - target = edge$target, - interaction = edge$interaction, - edge_type = "undirected", - category = category, - ptm_overlap = ptm_overlap_text, - stringsAsFactors = FALSE - ) - } else { - # For regulatory relationships - create bidirectional edge - consolidated_edge <- data.frame( - source = edge$source, - target = edge$target, - interaction = paste(edge$interaction, "(bidirectional)"), - edge_type = "bidirectional", - category = category, - ptm_overlap = ptm_overlap_text, - stringsAsFactors = FALSE - ) - } - - # Copy any additional columns from original edge - other_cols <- setdiff(names(edge), c("source", "target", "interaction")) - for (col in other_cols) { - consolidated_edge[[col]] <- edge[[col]] - } - - edge_key_final <- paste(edge$source, edge$target, consolidated_edge$interaction, sep = "-") - consolidated_edges[[edge_key_final]] <- consolidated_edge - - # Mark both directions as processed - processed_pairs <- c(processed_pairs, pair_key) - - } else { - # Keep as directed edge - directed_edge <- edge - directed_edge$edge_type <- "directed" - directed_edge$category <- category - directed_edge$ptm_overlap = ptm_overlap_text - - edge_key_final <- paste(edge$source, edge$target, edge$interaction, sep = "-") - consolidated_edges[[edge_key_final]] <- directed_edge - } - } - - # Convert list back to data frame - if (length(consolidated_edges) > 0) { - result <- do.call(rbind, consolidated_edges) - rownames(result) <- NULL - return(result) - } else { - return(edges[0, ]) # Return empty data frame with same structure - } -} - -# Get edge styling properties based on category and interaction type -getEdgeStyle <- function(interaction, category, edge_type) { - relationship_props <- getRelationshipProperties() - - if (category %in% names(relationship_props)) { - props <- relationship_props[[category]] - - # Handle regulatory relationships with specific colors - if (category == "regulatory" && "colors" %in% names(props)) { - base_interaction <- gsub(" \\(bidirectional\\)", "", interaction) - color <- if (base_interaction %in% names(props$colors)) { - props$colors[[base_interaction]] - } else { - "#666666" # Default gray - } - } else { - color <- props$color - } - - # Adjust arrow type based on edge type - arrow <- if (edge_type == "undirected") { - "none" - } else if (edge_type == "bidirectional") { - "triangle" # Will be handled specially in CSS - } else { - props$arrow - } - - return(list( - color = color, - style = props$style, - arrow = arrow, - width = props$width - )) - } else { - # Default styling for unknown relationships - return(relationship_props$other) - } -} - -createNodeElements <- function(nodes, displayLabelType = "id") { - if ("logFC" %in% names(nodes)) { - node_colors <- mapLogFCToColor(nodes$logFC) - } else { - node_colors <- rep("#D3D3D3", nrow(nodes)) - } - - label_column <- if (displayLabelType == "hgncName" && "hgncName" %in% names(nodes)) { - "hgncName" - } else { - "id" - } - - node_elements <- c() - ptm_elements <- c() - emitted_proteins <- c() - emitted_compounds <- c() - emitted_ptm_nodes <- c() - emitted_ptm_edges <- c() - - # Pre-compute which protein ids have at least one PTM site row, - # so we know upfront whether a compound wrapper is needed - has_ptm_sites <- if ("Site" %in% names(nodes)) { - ids_with_sites <- unique(nodes$id[!is.na(nodes$Site) & trimws(nodes$Site) != ""]) - ids_with_sites - } else { - c() - } - - for (i in seq_len(nrow(nodes))) { - row <- nodes[i, ] - color <- node_colors[i] - has_site <- "Site" %in% names(nodes) && !is.na(row$Site) && trimws(row$Site) != "" - - display_label <- if (label_column == "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__") - - # Emit invisible compound container node once per protein that has PTM children - if (needs_compound && !(compound_id %in% emitted_compounds)) { - node_elements <- c(node_elements, - paste0("{ data: { id: '", escape_js_string(compound_id), - "', node_type: 'compound' } }") - ) - emitted_compounds <- c(emitted_compounds, compound_id) - } - - # Emit protein node once, assigning it to the compound if one exists - if (!(row$id %in% emitted_proteins)) { - parent_field <- if (needs_compound) { - paste0(", parent: '", escape_js_string(compound_id), "'") - } else { - "" - } - node_elements <- c(node_elements, - paste0("{ data: { id: '", escape_js_string(row$id), - "', label: '", escape_js_string(display_label), - "', color: '", color, - "', node_type: 'protein'", - parent_field, - " } }") - ) - emitted_proteins <- c(emitted_proteins, row$id) - } - - # Emit one PTM child node + attachment edge per individual site - if (has_site) { - sites <- trimws(unlist(strsplit(as.character(row$Site), "[_,;|]"))) - sites <- unique(sites[sites != ""]) - - for (site in sites) { - ptm_node_id <- paste0(row$id, "__ptm__", site) - safe_ptm_id <- escape_js_string(ptm_node_id) - safe_parent <- escape_js_string(row$id) - safe_site <- escape_js_string(site) - - # PTM node also belongs to the same compound container - if (!(ptm_node_id %in% emitted_ptm_nodes)) { - ptm_elements <- c(ptm_elements, - paste0("{ data: { id: '", safe_ptm_id, - "', label: '", safe_site, - "', color: '", color, - "', parent_protein: '", safe_parent, - "', parent: '", escape_js_string(compound_id), "'", - ", node_type: 'ptm' } }") - ) - emitted_ptm_nodes <- c(emitted_ptm_nodes, ptm_node_id) - } - - ptm_edge_id_raw <- paste0(row$id, "__ptm_edge__", site) - if (!(ptm_edge_id_raw %in% emitted_ptm_edges)) { - ptm_edge_id <- escape_js_string(ptm_edge_id_raw) - ptm_elements <- c(ptm_elements, - paste0("{ data: { id: '", ptm_edge_id, - "', source: '", safe_parent, - "', target: '", safe_ptm_id, - "', edge_type: 'ptm_attachment',", - " category: 'ptm_attachment',", - " interaction: '',", - " color: '", color, "',", - " line_style: 'dotted',", - " arrow_shape: 'none',", - " width: 1.5,", - " tooltip: '' } }") - ) - emitted_ptm_edges <- c(emitted_ptm_edges, ptm_edge_id_raw) - } - } - } - } - - return(c(node_elements, ptm_elements)) -} - -createEdgeElements <- function(edges, nodes = NULL) { - if (nrow(edges) == 0) return(list()) - - # First consolidate edges - consolidated_edges <- consolidateEdges(edges, nodes) - - edge_elements <- list() - - for (i in 1:nrow(consolidated_edges)) { - row <- consolidated_edges[i,] - edge_key <- paste(row$source, row$target, row$interaction, sep = "-") - - # Get styling for this edge - style <- getEdgeStyle(row$interaction, row$category, row$edge_type) - - # Sanitize optional evidenceLink - evidence_link <- if ("evidenceLink" %in% names(row)) row$evidenceLink else NA_character_ - evidence_link <- ifelse(is.na(evidence_link) | evidence_link == "NA", "", evidence_link) - evidence_link <- escape_js_string(evidence_link) - - # Escape quotes in tooltip text for JavaScript safety - tooltip_text <- gsub("'", "\\\\'", row$ptm_overlap) - - # Create edge data with styling information and PTM overlap tooltip - edge_data <- paste0("{ data: { source: '", row$source, - "', target: '", row$target, - "', id: '", edge_key, - "', interaction: '", row$interaction, - "', edge_type: '", row$edge_type, - "', category: '", row$category, - "', evidenceLink: '", evidence_link, - "', color: '", style$color, - "', line_style: '", style$style, - "', arrow_shape: '", style$arrow, - "', width: ", style$width, - ", tooltip: '", tooltip_text, "' } }") - - edge_elements[[edge_key]] <- edge_data - } - - return(edge_elements) -} - -# Helper to safely embed strings into JS single-quoted literals -escape_js_string <- function(x) { - if (is.null(x)) return("") - x <- as.character(x) - x <- gsub("\\\\", "\\\\\\\\", x) # backslashes - x <- gsub("'", "\\\\'", x) # single quotes - x <- gsub("\r", "\\\\r", x) - x <- gsub("\n", "\\\\n", x) - x -} - -#' Generate Cytoscape visualization configuration -#' -#' This function creates a complete Cytoscape configuration object that can be -#' used to render a network visualization. It's decoupled from any specific -#' UI framework. -#' -#' @param nodes List of nodes from getSubnetworkFromIndra -#' @param edges List of edges from getSubnetworkFromIndra -#' @param display_label_type column of nodes table for displaying node names -#' @param container_id ID of the HTML container element (default: 'network-cy') -#' @param event_handlers Optional list of event handler configurations -#' @param layout_options Optional list of layout configuration options -#' @export -#' @return List containing: -#' - elements: Combined node and edge elements -#' - style: Cytoscape style configuration -#' - layout: Layout configuration -#' - container_id: Container element ID -#' - js_code: Complete JavaScript code (for backward compatibility) -generateCytoscapeConfig <- function(nodes, edges, - display_label_type = "id", - container_id = "network-cy", - event_handlers = NULL, - layout_options = NULL, - node_font_size = 12) { - - # Create elements - node_elements <- createNodeElements(nodes, display_label_type) - edge_elements <- createEdgeElements(edges, nodes) - - # Default layout options - default_layout <- list( - name = "dagre", - rankDir = "TB", - animate = TRUE, - fit = TRUE, - padding = 30, - spacingFactor = 1.5, - nodeSep = 50, - edgeSep = 20, - rankSep = 80 - ) - - # Merge with custom layout options if provided - layout_config <- default_layout - if (!is.null(layout_options)) { - for (layout_name in names(layout_options)) { - layout_config[[layout_name]] <- layout_options[[layout_name]] - } - } - - # Define the style configuration - style_config <- list( - list( - selector = "node", - style = list( - `background-color` = "data(color)", - label = "data(label)", - width = "function(ele) { var label = ele.data('label') || ''; var labelLength = label.length; return Math.max(60, Math.min(labelLength * 8 + 20, 150)); }", - height = "function(ele) { var label = ele.data('label') || ''; var labelLength = label.length; return Math.max(40, Math.min(labelLength * 2 + 30, 60)); }", - shape = "round-rectangle", - `font-size` = paste0(node_font_size, "px"), - `font-weight` = "bold", - color = "#000", - `text-valign` = "center", - `text-halign` = "center", - `text-wrap` = "wrap", - `text-max-width` = "function(ele) { var label = ele.data('label') || ''; var labelLength = label.length; return Math.max(50, Math.min(labelLength * 8 + 10, 140)); }", - `border-width` = 2, - `border-color` = "#333", - padding = "5px" - ) - ), - list( - selector = "edge", - style = list( - 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` = "function(ele) { return ele.data('edge_type') === 'bidirectional' ? 'triangle' : 'none'; }", - `source-arrow-color` = "data(color)", - `edge-text-rotation` = "autorotate", - `text-margin-y` = -12, - `text-halign` = "center", - `font-size` = "16px", - `font-weight` = "bold", - color = "data(color)", - `text-background-color` = "#ffffff", - `text-background-opacity` = 0.8, - `text-background-padding` = "2px" - ) - ), - list( - selector = "edge[category = 'complex']", - style = list( - `line-style` = "solid", - `target-arrow-shape` = "none", - `source-arrow-shape` = "none" - ) - ), - list( - selector = "edge[category = 'phosphorylation']", - style = list( - `line-style` = "dashed", - width = 2 - ) - ), - list( - selector = "edge[edge_type = 'bidirectional']", - style = list( - `source-arrow-shape` = "triangle", - `target-arrow-shape` = "triangle" - ) - ), - list( - selector = "node[node_type = 'ptm']", - style = list( - shape = "ellipse", - width = "20px", - height = "20px", - `background-color` = "data(color)", # <-- was hardcoded "#9932CC" - `border-color` = "#333", # <-- neutral border instead of purple - `border-width` = 1.5, - label = "data(label)", - `font-size` = "8px", - `font-weight` = "normal", - color = "#000000", # <-- dark text works across the logFC palette - `text-valign` = "center", - `text-halign` = "center", - `text-wrap` = "wrap", - `text-max-width` = "18px" - ) - ), - # --- PTM attachment edge style (hide label, keep it subtle) --- - list( - selector = "edge[edge_type = 'ptm_attachment']", - style = list( - `line-style` = "dotted", - `line-color` = "#9932CC", - width = 1.5, - `target-arrow-shape` = "none", - `source-arrow-shape` = "none", - label = "", # no label on these connector edges - `z-index` = 0 # render behind main edges - ) - ), - list( - selector = "node[node_type = 'compound']", - style = list( - `background-opacity` = 0, - `border-width` = 0, - `border-opacity` = 0, - `padding` = "10px", - label = "", - `z-index` = 0 - ) - ) - ) - - # Combine elements - elements <- c(node_elements, edge_elements) - - # Create the main configuration object - config <- list( - elements = elements, - style = style_config, - layout = layout_config, - container_id = container_id, - event_handlers = event_handlers - ) - - # Generate JavaScript code for backward compatibility - config$js_code <- generateJavaScriptCode(config) - - return(config) -} - -#' Generate JavaScript code from Cytoscape configuration -#' -#' Internal function to convert configuration object to JavaScript code -#' -#' @param config Configuration object from generateCytoscapeConfig() -#' @return Character string containing JavaScript code -generateJavaScriptCode <- function(config) { - - # Convert R list to JSON-like string for JavaScript - elements_js <- paste(config$elements, collapse = ", ") - - # Convert style configuration to JavaScript - style_js <- convertStyleToJS(config$style) - - # Convert layout configuration to JavaScript - layout_js <- convertLayoutToJS(config$layout) - - # Build event handlers JavaScript - event_handlers_js <- "" - if (!is.null(config$event_handlers)) { - handlers <- sapply(names(config$event_handlers), function(event) { - handler_code <- config$event_handlers[[event]] - switch(event, - "edge_click" = paste0("cy.on('tap', 'edge', ", handler_code, ");"), - "node_click" = paste0("cy.on('tap', 'node', ", handler_code, ");"), - handler_code # Custom event handler - ) - }) - event_handlers_js <- paste(handlers, collapse = "\n ") - } - - # Generate the complete JavaScript code - js_code <- paste0(" - cytoscape.use(cytoscapeDagre); - var cy = cytoscape({ - container: document.getElementById('", config$container_id, "'), - elements: [", elements_js, "], - style: ", style_js, ", - layout: ", layout_js, " - }); - - // After layout completes, reposition PTM nodes directly beside their parent protein - cy.on('layoutstop', function() { - var ptmNodes = cy.nodes('[node_type = \"ptm\"]'); - ptmNodes.forEach(function(ptmNode) { - var parentId = ptmNode.data('parent_protein'); - var parentNode = cy.getElementById(parentId); - if (parentNode.length === 0) return; - - var parentPos = parentNode.position(); - var parentW = parentNode.outerWidth(); - var parentH = parentNode.outerHeight(); - var ptmR = ptmNode.outerWidth() / 2; // PTM node is a small circle - - // Collect all PTM siblings so we can fan them around the parent - var siblings = cy.nodes('[parent_protein = \"' + parentId + '\"]'); - var idx = siblings.indexOf(ptmNode); - var total = siblings.length; - - // Distribute siblings evenly across the bottom arc of the parent - // angleStart/End in radians: spread across bottom 180 degrees - var angleStart = Math.PI * 0.15; - var angleEnd = Math.PI * 0.85; - var angle = total === 1 - ? Math.PI / 2 // single PTM: directly below center - : angleStart + (angleEnd - angleStart) * (idx / (total - 1)); - - // Place PTM node just outside the parent border - 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 - }); - }); - }); - - // Create tooltip element - var tooltip = document.createElement('div'); - tooltip.style.cssText = ` - position: absolute; - background-color: rgba(0, 0, 0, 0.9); - color: white; - padding: 8px 12px; - border-radius: 4px; - font-size: 12px; - font-family: Arial, sans-serif; - white-space: nowrap; - pointer-events: none; - z-index: 9999; - box-shadow: 0 2px 8px rgba(0, 0, 0, 0.3); - display: none; - max-width: 300px; - word-wrap: break-word; - white-space: pre-wrap; - `; - document.body.appendChild(tooltip); - - // Only show tooltip if there's actual PTM overlap information - cy.on('mouseover', 'edge', function(evt) { - var edge = evt.target; - var tooltipText = edge.data('tooltip'); - if (tooltipText && tooltipText.trim() !== '' && tooltipText.trim() !== 'No overlapping PTM sites found') { - tooltip.innerHTML = tooltipText; - tooltip.style.display = 'block'; - } - }); - - cy.on('mousemove', 'edge', function(evt) { - if (tooltip.style.display === 'block') { - tooltip.style.left = evt.originalEvent.pageX + 10 + 'px'; - tooltip.style.top = evt.originalEvent.pageY - 30 + 'px'; - } - }); - - cy.on('mouseout', 'edge', function(evt) { - tooltip.style.display = 'none'; - }); - - ", event_handlers_js) - - return(js_code) -} - -# Helper function to convert style list to JavaScript -convertStyleToJS <- function(style_list) { - style_items <- sapply(style_list, function(item) { - # Properly escape selector strings, especially those with special characters - selector_js <- paste0("\"", gsub("\"", "\\\"", item$selector), "\"") - - # Convert style properties - style_props <- sapply(names(item$style), function(prop) { - value <- item$style[[prop]] - if (is.character(value) && !grepl("^function\\(", value)) { - # Use double quotes and escape any existing double quotes - escaped_prop <- gsub("\"", "\\\"", prop) - escaped_value <- gsub("\"", "\\\"", value) - paste0("\"", escaped_prop, "\": \"", escaped_value, "\"") - } else { - escaped_prop <- gsub("\"", "\\\"", prop) - paste0("\"", escaped_prop, "\": ", value) - } - }) - - paste0("{ selector: ", selector_js, ", style: { ", paste(style_props, collapse = ", "), " } }") - }) - - paste0("[", paste(style_items, collapse = ", "), "]") -} - -# Helper function to convert layout list to JavaScript -convertLayoutToJS <- function(layout_list) { - layout_props <- sapply(names(layout_list), function(prop) { - value <- layout_list[[prop]] - if (is.character(value)) { - escaped_prop <- gsub("\"", "\\\"", prop) - escaped_value <- gsub("\"", "\\\"", value) - paste0("\"", escaped_prop, "\": \"", escaped_value, "\"") - } else if (is.logical(value)) { - escaped_prop <- gsub("\"", "\\\"", prop) - paste0("\"", escaped_prop, "\": ", tolower(value)) - } else { - escaped_prop <- gsub("\"", "\\\"", prop) - paste0("\"", escaped_prop, "\": ", value) - } - }) - - paste0("{ ", paste(layout_props, collapse = ", "), " }") -} - -#' Export Cytoscape network visualization to standalone HTML file -#' -#' This function takes a Cytoscape configuration object and creates a complete -#' standalone HTML file that can be opened in any web browser. -#' -#' @param config Configuration object from generateCytoscapeConfig() -#' @param filename Output HTML filename (default: "network_visualization.html") -#' @param title HTML page title (default: "Network Visualization") -#' @param width Container width (default: "100%") -#' @param height Container height (default: "600px") -#' @param include_controls Whether to include basic zoom/fit controls (default: TRUE) -#' @param custom_css Additional CSS styling (optional) -#' @param custom_js Additional JavaScript code (optional) -#' -#' @return Invisibly returns the file path of the created HTML file -#' -#' @examples -#' \dontrun{ -#' # Assuming you have nodes and edges data -#' config <- generateCytoscapeConfig(node_elements, edge_elements) -#' -#' # Export to HTML -#' exportCytoscapeToHTML(config, "my_network.html") -#' } -#' @noRd -exportCytoscapeToHTML <- function(config, - filename = "network_visualization.html", - title = "Network Visualization", - width = "100%", - height = "600px", - include_controls = TRUE, - custom_css = "", - custom_js = "") { - - # Validate config object - if (!is.list(config) || !all(c("elements", "style", "layout", "container_id") %in% names(config))) { - stop("Invalid config object. Must be generated by generateCytoscapeConfig()") - } - - # Generate the JavaScript code if not already present - if (!"js_code" %in% names(config)) { - config$js_code <- generateJavaScriptCode(config) - } - - # Create controls HTML and JavaScript if requested - controls_html <- "" - controls_js <- "" - controls_css <- "" - - if (include_controls) { - controls_html <- ' -
- - - - - - -
' - - controls_css <- ' - .control-btn { - margin: 2px; - padding: 6px 12px; - background-color: #f8f9fa; - border: 1px solid #dee2e6; - border-radius: 4px; - cursor: pointer; - font-size: 12px; - } - .control-btn:hover { - background-color: #e9ecef; - } - .control-btn:active { - background-color: #dee2e6; - } - .export-btn { - background-color: #28a745; - color: white; - border-color: #28a745; - font-weight: bold; - } - .export-btn:hover { - background-color: #218838; - border-color: #1e7e34; - } - .export-btn:active { - background-color: #1e7e34; - }' - - controls_js <- ' - // Add control event listeners - document.getElementById("fit-btn").addEventListener("click", function() { - cy.fit(); - }); - - document.getElementById("center-btn").addEventListener("click", function() { - cy.center(); - }); - - document.getElementById("zoom-in-btn").addEventListener("click", function() { - cy.zoom({ - level: cy.zoom() * 1.2, - renderedPosition: { x: cy.width()/2, y: cy.height()/2 } - }); - }); - - document.getElementById("zoom-out-btn").addEventListener("click", function() { - cy.zoom({ - level: cy.zoom() * 0.8, - renderedPosition: { x: cy.width()/2, y: cy.height()/2 } - }); - }); - - document.getElementById("reset-btn").addEventListener("click", function() { - cy.reset(); - cy.fit(); - }); - - // Export PNG functionality - document.getElementById("export-png-btn").addEventListener("click", function() { - const exportBtn = this; - const originalText = exportBtn.textContent; - - // Disable button and show loading state - exportBtn.disabled = true; - exportBtn.textContent = "Exporting..."; - - try { - // Generate high-resolution PNG (scale factor of 8 for high quality) - const png64 = cy.png({ - output: "base64uri", - bg: "white", - full: true, // Export the entire graph - scale: 10, // 10x resolution for publication quality - maxWidth: 10000, // Maximum width in pixels - maxHeight: 10000 // Maximum height in pixels - }); - - // Create download link - const link = document.createElement("a"); - link.href = png64; - link.download = "network_visualization_" + new Date().getTime() + ".png"; - - // Trigger download - document.body.appendChild(link); - link.click(); - document.body.removeChild(link); - - // Show success feedback - exportBtn.textContent = "Exported!"; - exportBtn.style.backgroundColor = "#28a745"; - - // Reset button after 2 seconds - setTimeout(function() { - exportBtn.disabled = false; - exportBtn.textContent = originalText; - exportBtn.style.backgroundColor = ""; - }, 2000); - - } catch (error) { - console.error("Error exporting PNG:", error); - alert("Error exporting PNG: " + error.message); - exportBtn.disabled = false; - exportBtn.textContent = originalText; - } - });' - } - - # Create the complete HTML content - html_content <- paste0(' - - - - - ', title, ' - - - - - - - - - - - -
-

', title, '

- - ', controls_html, ' - -
-
-
- -
-
- -
- Instructions: - Click and drag to pan the network - | Use mouse wheel to zoom in/out - | Hover over edges to see PTM site overlap information - | Click on nodes or edges to select them - ', if(include_controls) '| Use the buttons above for common navigation actions' else '', ' - ', if(include_controls) '| Export as PNG to save the current view in high resolution' else '', ' -
-
- - - -') - - # Write the HTML file - writeLines(html_content, filename) - - # Print success message - cat("Network visualization exported to:", normalizePath(filename), "\n") - - # Return the file path invisibly - invisible(normalizePath(filename)) -} - -#' @noRd -createEdgeClickHandler <- function() { - list( - edge_click = "function(evt) { - var edge = evt.target; - var evidenceLink = edge.data('evidenceLink'); - if (evidenceLink && evidenceLink !== '' && evidenceLink !== 'NA') { - openLinkInNewTab(evidenceLink); - } - }" - ) -} - -#' Export network data with Cytoscape visualization -#' -#' Convenience function that takes nodes and edges data directly and creates -#' both the configuration and HTML export in one step. -#' -#' @param nodes Data frame with node information -#' @param edges Data frame with edge information -#' @param filename Output HTML filename -#' @param displayLabelType Type of label to display ("id" or "hgncName") -#' @param nodeFontSize Font size for node labels (default: 12) -#' @param ... Additional arguments passed to exportCytoscapeToHTML() -#' @export -#' @return Invisibly returns the file path of the created HTML file -exportNetworkToHTML <- function(nodes, edges, - filename = "network_visualization.html", - displayLabelType = "id", - nodeFontSize = 12, - ...) { - - event_handlers <- createEdgeClickHandler() - - # Generate configuration - config <- generateCytoscapeConfig( - nodes, - edges, - display_label_type = displayLabelType, - node_font_size = nodeFontSize, - event_handlers = event_handlers - ) - - # Export to HTML - exportCytoscapeToHTML(config, filename, ...) -} - -#' Preview network in browser -#' -#' Creates a temporary HTML file and opens it in the default web browser -#' @export -#' @importFrom utils browseURL -#' @param nodes Data frame with node information -#' @param edges Data frame with edge information -#' @param displayLabelType Type of label to display ("id" or "hgncName") -#' @param ... Additional arguments passed to exportCytoscapeToHTML() -previewNetworkInBrowser <- function(nodes, edges, - displayLabelType = "id", - nodeFontSize = 12, - ...) { - - event_handlers <- createEdgeClickHandler() - - # Generate configuration - config <- generateCytoscapeConfig( - nodes, - edges, - display_label_type = displayLabelType, - node_font_size = nodeFontSize, - event_handlers = event_handlers - ) - - # Create temporary filename - temp_file <- tempfile(fileext = ".html") - - # Export to temp file - exportCytoscapeToHTML(config, temp_file, ...) - - # Open in browser - if (interactive()) { - browseURL(temp_file) - cat("Network opened in browser. Temporary file:", temp_file, "\n") - } - - invisible(temp_file) -} \ No newline at end of file diff --git a/man/exportNetworkToHTML.Rd b/man/exportNetworkToHTML.Rd index ca8f679..8e6521e 100644 --- a/man/exportNetworkToHTML.Rd +++ b/man/exportNetworkToHTML.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/visualizeNetworksWithHTML.R +% Please edit documentation in R/exportNetworkToHTML.R \name{exportNetworkToHTML} \alias{exportNetworkToHTML} \title{Export network data with Cytoscape visualization} @@ -14,15 +14,21 @@ exportNetworkToHTML( ) } \arguments{ -\item{nodes}{Data frame with node information} +\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 edge information} +\item{edges}{Data frame with columns \code{source}, \code{target}, +\code{interaction}. Optional: \code{site}, +\code{evidenceLink}.} \item{filename}{Output HTML filename} -\item{displayLabelType}{Type of label to display ("id" or "hgncName")} +\item{displayLabelType}{\code{"id"} (default) or \code{"hgncName"} – +controls which column is used as the visible node label.} -\item{nodeFontSize}{Font size for node labels (default: 12)} +\item{nodeFontSize}{Font size (px) for node labels. Default \code{12}.} \item{...}{Additional arguments passed to exportCytoscapeToHTML()} } diff --git a/man/generateCytoscapeConfig.Rd b/man/generateCytoscapeConfig.Rd deleted file mode 100644 index fc6c562..0000000 --- a/man/generateCytoscapeConfig.Rd +++ /dev/null @@ -1,42 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/visualizeNetworksWithHTML.R -\name{generateCytoscapeConfig} -\alias{generateCytoscapeConfig} -\title{Generate Cytoscape visualization configuration} -\usage{ -generateCytoscapeConfig( - nodes, - edges, - display_label_type = "id", - container_id = "network-cy", - event_handlers = NULL, - layout_options = NULL, - node_font_size = 12 -) -} -\arguments{ -\item{nodes}{List of nodes from getSubnetworkFromIndra} - -\item{edges}{List of edges from getSubnetworkFromIndra} - -\item{display_label_type}{column of nodes table for displaying node names} - -\item{container_id}{ID of the HTML container element (default: 'network-cy')} - -\item{event_handlers}{Optional list of event handler configurations} - -\item{layout_options}{Optional list of layout configuration options} -} -\value{ -List containing: - - elements: Combined node and edge elements - - style: Cytoscape style configuration - - layout: Layout configuration - - container_id: Container element ID - - js_code: Complete JavaScript code (for backward compatibility) -} -\description{ -This function creates a complete Cytoscape configuration object that can be -used to render a network visualization. It's decoupled from any specific -UI framework. -} diff --git a/man/generateJavaScriptCode.Rd b/man/generateJavaScriptCode.Rd deleted file mode 100644 index 3e4beea..0000000 --- a/man/generateJavaScriptCode.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/visualizeNetworksWithHTML.R -\name{generateJavaScriptCode} -\alias{generateJavaScriptCode} -\title{Generate JavaScript code from Cytoscape configuration} -\usage{ -generateJavaScriptCode(config) -} -\arguments{ -\item{config}{Configuration object from generateCytoscapeConfig()} -} -\value{ -Character string containing JavaScript code -} -\description{ -Internal function to convert configuration object to JavaScript code -} diff --git a/man/previewNetworkInBrowser.Rd b/man/previewNetworkInBrowser.Rd index d0ac40e..12eeed9 100644 --- a/man/previewNetworkInBrowser.Rd +++ b/man/previewNetworkInBrowser.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/visualizeNetworksWithHTML.R +% Please edit documentation in R/exportNetworkToHTML.R \name{previewNetworkInBrowser} \alias{previewNetworkInBrowser} \title{Preview network in browser} @@ -8,18 +8,23 @@ previewNetworkInBrowser( nodes, edges, displayLabelType = "id", - nodeFontSize = 12, - ... + nodeFontSize = 12 ) } \arguments{ -\item{nodes}{Data frame with node information} +\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 edge information} +\item{edges}{Data frame with columns \code{source}, \code{target}, +\code{interaction}. Optional: \code{site}, +\code{evidenceLink}.} -\item{displayLabelType}{Type of label to display ("id" or "hgncName")} +\item{displayLabelType}{\code{"id"} (default) or \code{"hgncName"} – +controls which column is used as the visible node label.} -\item{...}{Additional arguments passed to exportCytoscapeToHTML()} +\item{nodeFontSize}{Font size (px) for node labels. Default \code{12}.} } \description{ Creates a temporary HTML file and opens it in the default web browser diff --git a/tests/testthat/test-exportNetworkToHTML.R b/tests/testthat/test-exportNetworkToHTML.R new file mode 100644 index 0000000..3a49a29 --- /dev/null +++ b/tests/testthat/test-exportNetworkToHTML.R @@ -0,0 +1,164 @@ +library(mockery) + +make_nodes <- function() { + data.frame( + id = c("P53_HUMAN", "MDM2_HUMAN"), + logFC = c(1.5, -1.0), + stringsAsFactors = FALSE + ) +} + +make_edges <- function() { + data.frame( + source = "P53_HUMAN", + target = "MDM2_HUMAN", + interaction = "Activation", + stringsAsFactors = FALSE + ) +} + +test_that("exportNetworkToHTML calls saveWidget with the correct filename", { + tmp <- tempfile(fileext = ".html") + + save_widget_mock <- mock() + stub(exportNetworkToHTML, "htmlwidgets::saveWidget", save_widget_mock) + + exportNetworkToHTML(make_nodes(), make_edges(), filename = tmp) + + expect_called(save_widget_mock, 1) + call_args <- mock_args(save_widget_mock)[[1]] + expect_equal(call_args$file, tmp) +}) + +test_that("exportNetworkToHTML calls saveWidget with selfcontained = TRUE", { + save_widget_mock <- mock() + stub(exportNetworkToHTML, "htmlwidgets::saveWidget", save_widget_mock) + + exportNetworkToHTML(make_nodes(), make_edges(), filename = tempfile(fileext = ".html")) + + call_args <- mock_args(save_widget_mock)[[1]] + expect_true(call_args$selfcontained) +}) + +test_that("exportNetworkToHTML passes a cytoscapeNetwork widget to saveWidget", { + save_widget_mock <- mock() + stub(exportNetworkToHTML, "htmlwidgets::saveWidget", save_widget_mock) + + exportNetworkToHTML(make_nodes(), make_edges(), filename = tempfile(fileext = ".html")) + + widget_arg <- mock_args(save_widget_mock)[[1]][[1]] + expect_s3_class(widget_arg, "htmlwidget") + expect_s3_class(widget_arg, "cytoscapeNetwork") +}) + +test_that("exportNetworkToHTML passes nodeFontSize through to the widget", { + save_widget_mock <- mock() + stub(exportNetworkToHTML, "htmlwidgets::saveWidget", save_widget_mock) + + exportNetworkToHTML(make_nodes(), make_edges(), + filename = tempfile(fileext = ".html"), + nodeFontSize = 18) + + widget_arg <- mock_args(save_widget_mock)[[1]][[1]] + expect_equal(widget_arg$x$node_font_size, 18) +}) + +test_that("exportNetworkToHTML passes displayLabelType through to the widget", { + save_widget_mock <- mock() + stub(exportNetworkToHTML, "htmlwidgets::saveWidget", save_widget_mock) + + nodes_hgnc <- make_nodes() + nodes_hgnc$hgncName <- c("TP53", "MDM2") + + exportNetworkToHTML(nodes_hgnc, make_edges(), + filename = tempfile(fileext = ".html"), + displayLabelType = "hgncName") + + widget_arg <- mock_args(save_widget_mock)[[1]][[1]] + protein_nodes <- Filter(function(el) !is.null(el$data$node_type) && + el$data$node_type == "protein", + widget_arg$x$elements) + labels <- sapply(protein_nodes, function(el) el$data$label) + expect_length(labels, 2) + expect_setequal(labels, c("TP53", "MDM2")) +}) + +# ============================================================================= +# previewNetworkInBrowser — mock saveWidget and browseURL +# ============================================================================= + +test_that("previewNetworkInBrowser calls exportNetworkToHTML with a .html temp path", { + export_mock <- mock(invisible(NULL)) + stub(previewNetworkInBrowser, "exportNetworkToHTML", export_mock) + stub(previewNetworkInBrowser, "interactive", mock(FALSE)) + + previewNetworkInBrowser(make_nodes(), make_edges()) + + expect_called(export_mock, 1) + call_args <- mock_args(export_mock)[[1]] + expect_true(grepl("\\.html$", call_args$filename)) +}) + +test_that("previewNetworkInBrowser calls browseURL when interactive() is TRUE", { + browse_mock <- mock(invisible(NULL)) + export_mock <- mock(invisible(NULL)) + mock_interactive <- mock(TRUE) + + stub(previewNetworkInBrowser, "exportNetworkToHTML", export_mock) + stub(previewNetworkInBrowser, "browseURL", browse_mock) + stub(previewNetworkInBrowser, "interactive", mock_interactive) + + previewNetworkInBrowser(make_nodes(), make_edges()) + + expect_called(browse_mock, 1) +}) + +test_that("previewNetworkInBrowser passes the temp filename to browseURL", { + captured_filename <- NULL + browse_mock <- mock(invisible(NULL)) + + stub(previewNetworkInBrowser, "exportNetworkToHTML", + function(nodes, edges, filename, ...) { + captured_filename <<- filename + invisible(filename) + }) + stub(previewNetworkInBrowser, "browseURL", browse_mock) + stub(previewNetworkInBrowser, "interactive", mock(TRUE)) + + result <- previewNetworkInBrowser(make_nodes(), make_edges()) + + browse_arg <- mock_args(browse_mock)[[1]][[1]] + expect_equal(browse_arg, captured_filename) + expect_equal(result, captured_filename) +}) + +test_that("previewNetworkInBrowser does NOT call browseURL when non-interactive", { + browse_mock <- mock(invisible(NULL)) + export_mock <- mock(invisible(NULL)) + + + stub(previewNetworkInBrowser, "exportNetworkToHTML", export_mock) + stub(previewNetworkInBrowser, "utils::browseURL", browse_mock) + stub(previewNetworkInBrowser, "interactive", mock(FALSE)) + + previewNetworkInBrowser(make_nodes(), make_edges()) + + expect_called(browse_mock, 0) +}) + +test_that("previewNetworkInBrowser passes nodeFontSize and displayLabelType through", { + export_mock <- mock(invisible(NULL)) + stub(previewNetworkInBrowser, "exportNetworkToHTML", export_mock) + stub(previewNetworkInBrowser, "interactive", mock(FALSE)) + + nodes_hgnc <- make_nodes() + nodes_hgnc$hgncName <- c("TP53", "MDM2") + + previewNetworkInBrowser(nodes_hgnc, make_edges(), + displayLabelType = "hgncName", + nodeFontSize = 16) + + call_args <- mock_args(export_mock)[[1]] + expect_equal(call_args$displayLabelType, "hgncName") + expect_equal(call_args$nodeFontSize, 16) +}) \ No newline at end of file diff --git a/tests/testthat/test-utils_cytoscapeNetwork.R b/tests/testthat/test-utils_cytoscapeNetwork.R new file mode 100644 index 0000000..407f657 --- /dev/null +++ b/tests/testthat/test-utils_cytoscapeNetwork.R @@ -0,0 +1,324 @@ +# ============================================================================= +# MOCK DATA +# ============================================================================= + +create_mock_nodes <- function() { + data.frame( + id = c("P53_HUMAN", "MDM2_HUMAN", "ATM_HUMAN", "BRCA1_HUMAN"), + logFC = c(2.5, -1.8, 1.2, -2.1), + pvalue = c(0.001, 0.02, 0.03, 0.005), + hgncName = c("TP53", "MDM2", "ATM", "BRCA1"), + stringsAsFactors = FALSE + ) +} + +create_mock_nodes_ptm <- function() { + data.frame( + id = c("P53_HUMAN", "MDM2_HUMAN"), + logFC = c(2.5, -1.8), + hgncName = c("TP53", "MDM2"), + Site = c(NA, "S15_S20"), + stringsAsFactors = FALSE + ) +} + +create_mock_edges <- function() { + data.frame( + source = c("P53_HUMAN", "MDM2_HUMAN", "ATM_HUMAN", "P53_HUMAN", "BRCA1_HUMAN"), + target = c("MDM2_HUMAN", "P53_HUMAN", "P53_HUMAN", "BRCA1_HUMAN", "P53_HUMAN"), + interaction = c("Inhibition", "Inhibition", "Phosphorylation", "Complex", "Complex"), + evidenceLink = c("link1", "link2", "link3", "link4", "link5"), + stringsAsFactors = FALSE + ) +} + +create_mock_edges_ptm <- function() { + data.frame( + source = c("P53_HUMAN"), + target = c("MDM2_HUMAN"), + interaction = c("Phosphorylation"), + site = c("S15"), + stringsAsFactors = FALSE + ) +} + +# ============================================================================= +# .mapLogFCToColor +# ============================================================================= + +test_that(".mapLogFCToColor returns valid hex colours", { + colors <- MSstatsBioNet:::.mapLogFCToColor(c(-2, -1, 0, 1, 2)) + expect_length(colors, 5) + expect_true(all(grepl("^#[0-9A-Fa-f]{6}$", colors))) +}) + +test_that(".mapLogFCToColor returns grey for all-NA input", { + colors <- MSstatsBioNet:::.mapLogFCToColor(c(NA, NA, NA)) + expect_length(colors, 3) + expect_true(all(colors == "#D3D3D3")) +}) + +test_that(".mapLogFCToColor returns grey for all-identical values", { + colors <- MSstatsBioNet:::.mapLogFCToColor(c(1, 1, 1)) + expect_length(colors, 3) + expect_true(all(colors == "#D3D3D3")) +}) + +test_that(".mapLogFCToColor handles empty input", { + colors <- MSstatsBioNet:::.mapLogFCToColor(numeric(0)) + expect_length(colors, 0) +}) + +# ============================================================================= +# .relProps +# ============================================================================= + +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, "bidirectional") + expect_equal(props$phosphorylation$consolidate, "directed") + + expect_true("Inhibition" %in% names(props$regulatory$colors)) + expect_true("Activation" %in% names(props$regulatory$colors)) +}) + +# ============================================================================= +# .classify +# ============================================================================= + +test_that(".classify maps interaction types to correct categories", { + expect_equal(MSstatsBioNet:::.classify("Inhibition"), "regulatory") + expect_equal(MSstatsBioNet:::.classify("Activation"), "regulatory") + expect_equal(MSstatsBioNet:::.classify("Phosphorylation"), "phosphorylation") + expect_equal(MSstatsBioNet:::.classify("Complex"), "complex") + expect_equal(MSstatsBioNet:::.classify("Unknown"), "other") +}) + +# ============================================================================= +# .edgeStyle +# ============================================================================= + +test_that(".edgeStyle returns correct colour for regulatory interactions", { + style <- MSstatsBioNet:::.edgeStyle("Inhibition", "regulatory", "directed") + expect_type(style, "list") + expect_equal(style$color, "#FF4444") + + style_act <- MSstatsBioNet:::.edgeStyle("Activation", "regulatory", "directed") + expect_equal(style_act$color, "#44AA44") +}) + +test_that(".edgeStyle returns no arrow for undirected complex edges", { + style <- MSstatsBioNet:::.edgeStyle("Complex", "complex", "undirected") + expect_equal(style$arrow, "none") + expect_equal(style$color, "#8B4513") +}) + +test_that(".edgeStyle returns triangle arrows for bidirectional edges", { + style <- MSstatsBioNet:::.edgeStyle("Inhibition (bidirectional)", "regulatory", "bidirectional") + expect_equal(style$arrow, "triangle") +}) + +test_that(".edgeStyle falls back to grey for unknown category", { + style <- MSstatsBioNet:::.edgeStyle("Unknown", "other", "directed") + expect_equal(style$color, "#666666") +}) + +# ============================================================================= +# .consolidateEdges +# ============================================================================= + +test_that(".consolidateEdges consolidates bidirectional inhibition into one edge", { + edges <- create_mock_edges() + result <- MSstatsBioNet:::.consolidateEdges(edges) + + expect_s3_class(result, "data.frame") + expect_true(all(c("edge_type", "category", "ptm_overlap") %in% names(result))) + + # Two Inhibition edges in opposite directions → one bidirectional edge + inhibition <- result[grepl("Inhibition", result$interaction), ] + expect_equal(nrow(inhibition), 1) + expect_equal(inhibition$edge_type, "bidirectional") +}) + +test_that(".consolidateEdges marks phosphorylation as directed", { + edges <- create_mock_edges() + result <- MSstatsBioNet:::.consolidateEdges(edges) + + phospho <- result[result$interaction == "Phosphorylation", ] + expect_equal(nrow(phospho), 1) + expect_equal(phospho$edge_type, "directed") + expect_equal(phospho$category, "phosphorylation") +}) + +test_that(".consolidateEdges marks complex as undirected", { + edges <- create_mock_edges() + result <- MSstatsBioNet:::.consolidateEdges(edges) + + complex <- result[result$interaction == "Complex", ] + expect_equal(nrow(complex), 1) + expect_equal(complex$edge_type, "undirected") +}) + +test_that(".consolidateEdges handles empty input", { + empty <- data.frame(source = character(0), target = character(0), + interaction = character(0), stringsAsFactors = FALSE) + result <- MSstatsBioNet:::.consolidateEdges(empty) + expect_equal(nrow(result), 0) +}) + +# ============================================================================= +# .ptmOverlap +# ============================================================================= + +test_that(".ptmOverlap detects overlapping PTM sites", { + nodes <- create_mock_nodes_ptm() + edges <- create_mock_edges_ptm() + + result <- MSstatsBioNet:::.ptmOverlap(edges, nodes) + expect_type(result, "character") + expect_length(result, 1) + expect_true(grepl("S15", result[[1]])) +}) + +test_that(".ptmOverlap returns empty string when no overlap", { + nodes <- create_mock_nodes_ptm() + edges <- data.frame(source = "P53_HUMAN", target = "MDM2_HUMAN", + interaction = "Phosphorylation", site = "T999", + stringsAsFactors = FALSE) + result <- MSstatsBioNet:::.ptmOverlap(edges, nodes) + expect_equal(result[[1]], "") +}) + +test_that(".ptmOverlap handles empty edges gracefully", { + nodes <- create_mock_nodes_ptm() + empty <- data.frame(source = character(0), target = character(0), + interaction = character(0), stringsAsFactors = FALSE) + result <- MSstatsBioNet:::.ptmOverlap(empty, nodes) + expect_length(result, 0) +}) + +# ============================================================================= +# .buildElements +# ============================================================================= + +test_that(".buildElements returns a list of elements", { + nodes <- create_mock_nodes() + edges <- create_mock_edges() + result <- MSstatsBioNet:::.buildElements(nodes, edges) + + expect_type(result, "list") + expect_gt(length(result), nrow(nodes)) # nodes + edges +}) + +test_that(".buildElements assigns correct node_type to proteins", { + nodes <- create_mock_nodes() + result <- MSstatsBioNet:::.buildElements(nodes, data.frame()) + + node_types <- sapply(result, function(el) el$data$node_type) + expect_true(all(node_types == "protein")) +}) + +test_that(".buildElements creates PTM child nodes and attachment edges", { + nodes <- create_mock_nodes_ptm() + result <- MSstatsBioNet:::.buildElements(nodes, data.frame()) + + node_types <- sapply(result, function(el) el$data$node_type) + expect_true("ptm" %in% node_types) + expect_true("compound" %in% node_types) + + edge_types <- sapply(result, function(el) el$data$edge_type) + expect_true("ptm_attachment" %in% edge_types) +}) + +test_that(".buildElements uses hgncName label when requested", { + nodes <- create_mock_nodes() + result <- MSstatsBioNet:::.buildElements(nodes, data.frame(), "hgncName") + + protein_nodes <- Filter(function(el) !is.null(el$data$node_type) && + el$data$node_type == "protein", result) + labels <- sapply(protein_nodes, function(el) el$data$label) + expect_true(all(labels %in% c("TP53", "MDM2", "ATM", "BRCA1"))) +}) + +test_that(".buildElements falls back to id when hgncName is NA", { + nodes <- create_mock_nodes() + nodes$hgncName <- NA + result <- MSstatsBioNet:::.buildElements(nodes, data.frame(), "hgncName") + + protein_nodes <- Filter(function(el) !is.null(el$data$node_type) && + el$data$node_type == "protein", result) + labels <- sapply(protein_nodes, function(el) el$data$label) + expect_true(all(labels %in% nodes$id)) +}) + +test_that(".buildElements computes width and height from label length", { + nodes <- create_mock_nodes() + result <- MSstatsBioNet:::.buildElements(nodes, data.frame()) + + protein_nodes <- Filter(function(el) !is.null(el$data$node_type) && + el$data$node_type == "protein", result) + widths <- sapply(protein_nodes, function(el) el$data$width) + heights <- sapply(protein_nodes, function(el) el$data$height) + + expect_true(all(widths >= 60 & widths <= 150)) + expect_true(all(heights >= 40 & heights <= 60)) +}) + +test_that(".buildElements uses grey when logFC column is absent", { + nodes <- create_mock_nodes()[, !names(create_mock_nodes()) %in% "logFC"] + result <- MSstatsBioNet:::.buildElements(nodes, data.frame()) + + protein_nodes <- Filter(function(el) !is.null(el$data$node_type) && + el$data$node_type == "protein", result) + colors <- sapply(protein_nodes, function(el) el$data$color) + expect_true(all(colors == "#D3D3D3")) +}) + +# ============================================================================= +# cytoscapeNetwork() — public API +# ============================================================================= + +test_that("cytoscapeNetwork() returns an htmlwidget", { + w <- cytoscapeNetwork(create_mock_nodes(), create_mock_edges()) + expect_s3_class(w, "htmlwidget") + expect_s3_class(w, "cytoscapeNetwork") +}) + +test_that("cytoscapeNetwork() x list contains elements and layout", { + w <- cytoscapeNetwork(create_mock_nodes(), create_mock_edges()) + expect_true("elements" %in% names(w$x)) + expect_true("layout" %in% names(w$x)) + expect_gt(length(w$x$elements), 0) +}) + +test_that("cytoscapeNetwork() passes custom layout options through", { + w <- cytoscapeNetwork(create_mock_nodes(), create_mock_edges(), + layoutOptions = list(rankDir = "LR", rankSep = 120)) + expect_equal(w$x$layout$rankDir, "LR") + expect_equal(w$x$layout$rankSep, 120) +}) + +test_that("cytoscapeNetwork() passes nodeFontSize through", { + w <- cytoscapeNetwork(create_mock_nodes(), create_mock_edges(), nodeFontSize = 18) + expect_equal(w$x$node_font_size, 18) +}) + +test_that("cytoscapeNetwork() accepts empty edges", { + empty_edges <- data.frame(source = character(0), target = character(0), + interaction = character(0), stringsAsFactors = FALSE) + expect_no_error(cytoscapeNetwork(create_mock_nodes(), empty_edges)) +}) + +test_that("cytoscapeNetwork() errors when nodes has no id column", { + bad_nodes <- data.frame(name = c("A", "B"), stringsAsFactors = FALSE) + expect_error(cytoscapeNetwork(bad_nodes), "`id` column") +}) + +test_that("cytoscapeNetwork() errors when nodes is not a data frame", { + expect_error(cytoscapeNetwork(list(id = "A")), "id column|data frame") +}) \ No newline at end of file diff --git a/tests/testthat/test-visualizeNetworksWithHTML.R b/tests/testthat/test-visualizeNetworksWithHTML.R deleted file mode 100644 index 7746023..0000000 --- a/tests/testthat/test-visualizeNetworksWithHTML.R +++ /dev/null @@ -1,327 +0,0 @@ -# ============================================================================= -# UNIT TESTS FOR NETWORK VISUALIZATION MODULE -# ============================================================================= - -# Load required libraries - -# ============================================================================= -# MOCK DATA SETUP -# ============================================================================= - -# Mock data for testing -create_mock_input_data <- function() { - data.frame( - Protein = c("P53_HUMAN", "MDM2_HUMAN", "ATM_HUMAN", "BRCA1_HUMAN"), - log2FC = c(2.5, -1.8, 1.2, -2.1), - adj.pvalue = c(0.001, 0.02, 0.03, 0.005), - Label = rep("Treatment_vs_Control", 4), - stringsAsFactors = FALSE - ) -} - -create_mock_annotated_data <- function() { - data.frame( - Protein = c("P53_HUMAN", "MDM2_HUMAN", "ATM_HUMAN", "BRCA1_HUMAN"), - log2FC = c(2.5, -1.8, 1.2, -2.1), - adj.pvalue = c(0.001, 0.02, 0.03, 0.005), - Label = rep("Treatment_vs_Control", 4), - HgncId = c("101", "102", "103", "104"), - HgncName = c("TP53", "MDM2", "ATM", "BRCA1"), - stringsAsFactors = FALSE - ) -} - -create_mock_subnetwork_nodes <- function() { - data.frame( - id = c("P53_HUMAN", "MDM2_HUMAN", "ATM_HUMAN", "BRCA1_HUMAN"), - logFC = c(2.5, -1.8, 1.2, -2.1), - pvalue = c(0.001, 0.02, 0.03, 0.005), - hgncName = c("TP53", "MDM2", "ATM", "BRCA1"), - stringsAsFactors = FALSE - ) -} - -create_mock_subnetwork_edges <- function() { - data.frame( - source = c("TP53", "MDM2", "ATM", "TP53"), - target = c("MDM2", "TP53", "TP53", "BRCA1"), - interaction = c("Inhibition", "Activation", "Phosphorylation", "Complex"), - evidenceCount = c(15, 8, 12, 5), - evidenceLink = c("link1", "link2", "link3", "link4"), - source_counts = c("{reach:10, signor:5}", "{reach:5,biopax:3}", "{reach:8,phosphoelm:4}", "{biopax:5}"), - stringsAsFactors = FALSE - ) -} - -create_mock_subnetwork <- function() { - list( - nodes = create_mock_subnetwork_nodes(), - edges = create_mock_subnetwork_edges() - ) -} - -# ============================================================================= -# TESTS FOR COLOR MAPPING FUNCTION -# ============================================================================= - -test_that("mapLogFCToColor handles various input scenarios", { - - # Test normal case with varied logFC values - logFC_values <- c(-2, -1, 0, 1, 2) - colors <- mapLogFCToColor(logFC_values) - expect_equal(length(colors), 5) - expect_true(all(grepl("^#[0-9A-Fa-f]{6}$", colors))) # Valid hex colors - - # Test case with all NA values - na_values <- c(NA, NA, NA) - na_colors <- mapLogFCToColor(na_values) - expect_equal(length(na_colors), 3) - expect_true(all(na_colors == "#D3D3D3")) - - # Test case with all same values - same_values <- c(1, 1, 1) - same_colors <- mapLogFCToColor(same_values) - expect_equal(length(same_colors), 3) - expect_true(all(same_colors == "#D3D3D3")) - - # Test empty input - empty_colors <- mapLogFCToColor(numeric(0)) - expect_equal(length(empty_colors), 0) -}) - -# ============================================================================= -# TESTS FOR RELATIONSHIP PROPERTIES -# ============================================================================= - -test_that("getRelationshipProperties returns correct structure", { - props <- getRelationshipProperties() - - expect_type(props, "list") - expect_true("complex" %in% names(props)) - expect_true("regulatory" %in% names(props)) - expect_true("phosphorylation" %in% names(props)) - expect_true("other" %in% names(props)) - - # Test complex properties - complex_props <- props$complex - expect_true("types" %in% names(complex_props)) - expect_true("Complex" %in% complex_props$types) - expect_equal(complex_props$consolidate, "undirected") - - # Test regulatory properties - reg_props <- props$regulatory - expect_true("colors" %in% names(reg_props)) - expect_true("Inhibition" %in% names(reg_props$colors)) - expect_equal(reg_props$consolidate, "bidirectional") -}) - -# ============================================================================= -# TESTS FOR EDGE CONSOLIDATION -# ============================================================================= - -test_that("consolidateEdges properly consolidates bidirectional relationships", { - - # Create test edges with bidirectional regulatory relationships - test_edges <- data.frame( - source = c("TP53", "MDM2", "ATM", "BRCA1"), - target = c("MDM2", "TP53", "TP53", "ATM"), - interaction = c("Inhibition", "Inhibition", "Phosphorylation", "Complex"), - stringsAsFactors = FALSE - ) - - consolidated <- consolidateEdges(test_edges) - - expect_s3_class(consolidated, "data.frame") - expect_true("edge_type" %in% names(consolidated)) - expect_true("category" %in% names(consolidated)) - - # Should have fewer edges than original due to consolidation - expect_lt(nrow(consolidated), nrow(test_edges)) - - # Check that bidirectional inhibition was consolidated - inhibition_edges <- consolidated[grepl("Inhibition", consolidated$interaction), ] - expect_equal(nrow(inhibition_edges), 1) - expect_equal(inhibition_edges$edge_type, "bidirectional") -}) - -test_that("consolidateEdges handles empty input", { - empty_edges <- data.frame( - source = character(0), - target = character(0), - interaction = character(0), - stringsAsFactors = FALSE - ) - - result <- consolidateEdges(empty_edges) - expect_equal(nrow(result), 0) -}) - -# ============================================================================= -# TESTS FOR EDGE STYLING -# ============================================================================= - -test_that("getEdgeStyle returns appropriate styling", { - - # Test regulatory relationship styling - style <- getEdgeStyle("Inhibition", "regulatory", "directed") - expect_type(style, "list") - expect_true("color" %in% names(style)) - expect_equal(style$color, "#FF4444") # Red for inhibition - - # Test complex relationship styling - complex_style <- getEdgeStyle("Complex", "complex", "undirected") - expect_equal(complex_style$arrow, "none") - expect_equal(complex_style$color, "#8B4513") - - # Test unknown relationship - unknown_style <- getEdgeStyle("Unknown", "other", "directed") - expect_equal(unknown_style$color, "#666666") -}) - -# ============================================================================= -# TESTS FOR NODE ELEMENT CREATION -# ============================================================================= - -test_that("createNodeElements creates proper node structures", { - nodes <- create_mock_subnetwork_nodes() - - # Test with default label type (id) - node_elements <- createNodeElements(nodes, "id") - expect_equal(length(node_elements), nrow(nodes)) - expect_true(all(grepl("data:", node_elements))) - expect_true(all(grepl("id:", node_elements))) - expect_true(all(grepl("label:", node_elements))) - - # Test with hgncName label type - node_elements_hgnc <- createNodeElements(nodes, "hgncName") - expect_equal(length(node_elements_hgnc), nrow(nodes)) - - # Test nodes without logFC column - nodes_no_logfc <- nodes[, !names(nodes) %in% "logFC"] - node_elements_no_logfc <- createNodeElements(nodes_no_logfc, "id") - expect_equal(length(node_elements_no_logfc), nrow(nodes_no_logfc)) -}) - -# ============================================================================= -# TESTS FOR EDGE ELEMENT CREATION -# ============================================================================= - -test_that("createEdgeElements creates proper edge structures", { - edges <- create_mock_subnetwork_edges() - - edge_elements <- createEdgeElements(edges) - expect_type(edge_elements, "list") - expect_gt(length(edge_elements), 0) - - # Check that all elements contain required fields - expect_true(all(sapply(edge_elements, function(x) grepl("source:", x)))) - expect_true(all(sapply(edge_elements, function(x) grepl("target:", x)))) - - # Test empty edges - empty_edges <- data.frame( - source = character(0), - target = character(0), - interaction = character(0), - stringsAsFactors = FALSE - ) - empty_elements <- createEdgeElements(empty_edges) - expect_equal(length(empty_elements), 0) -}) - -# ============================================================================= -# TESTS FOR CYTOSCAPE CONFIG GENERATION -# ============================================================================= - -test_that("generateCytoscapeConfig creates complete configuration", { - nodes <- create_mock_subnetwork_nodes() - edges <- create_mock_subnetwork_edges() - - config <- generateCytoscapeConfig(nodes, edges) - - expect_type(config, "list") - expect_true("elements" %in% names(config)) - expect_true("style" %in% names(config)) - expect_true("layout" %in% names(config)) - expect_true("container_id" %in% names(config)) - expect_true("js_code" %in% names(config)) - - expect_equal(config$container_id, "network-cy") - expect_type(config$js_code, "character") - expect_gt(nchar(config$js_code), 100) -}) - -test_that("generateCytoscapeConfig accepts custom parameters", { - nodes <- create_mock_subnetwork_nodes() - edges <- create_mock_subnetwork_edges() - - custom_layout <- list(name = "grid", fit = FALSE) - custom_handlers <- list(edge_click = "function() { console.log('test'); }") - - config <- generateCytoscapeConfig( - nodes, - edges, - container_id = "custom-container", - event_handlers = custom_handlers, - layout_options = custom_layout - ) - - expect_equal(config$container_id, "custom-container") - expect_equal(config$layout$name, "grid") - expect_false(config$layout$fit) - expect_true(grepl("console.log", config$js_code)) -}) - - -# ============================================================================= -# TESTS FOR STYLE CONVERSION FUNCTIONS -# ============================================================================= - -test_that("convertStyleToJS creates valid JavaScript", { - style_list <- list( - list( - selector = "node", - style = list( - `background-color` = "data(color)", - width = "60px" - ) - ) - ) - - js_style <- convertStyleToJS(style_list) - expect_type(js_style, "character") - expect_true(grepl("selector", js_style)) - expect_true(grepl("background-color", js_style)) - expect_true(grepl("data\\(color\\)", js_style)) -}) - -test_that("convertLayoutToJS creates valid JavaScript", { - layout_list <- list( - name = "dagre", - fit = TRUE, - padding = 30 - ) - - js_layout <- convertLayoutToJS(layout_list) - expect_type(js_layout, "character") - expect_true(grepl("\"name\": \"dagre\"", js_layout)) - expect_true(grepl("\"fit\": true", js_layout)) - expect_true(grepl("\"padding\": 30", js_layout)) -}) - -test_that("createNodeElements handles different label types", { - nodes <- create_mock_subnetwork_nodes() - - # Test with id labels - elements_id <- createNodeElements(nodes, "id") - expect_true(all(grepl("P53_HUMAN|MDM2_HUMAN|ATM_HUMAN|BRCA1_HUMAN", elements_id))) - - # Test with hgncName labels - elements_hgnc <- createNodeElements(nodes, "hgncName") - expect_true(all(grepl("TP53|MDM2|ATM|BRCA1", elements_hgnc))) - - # Test with nodes missing hgncName - nodes_no_hgnc <- nodes - nodes_no_hgnc$hgncName <- NA - elements_fallback <- createNodeElements(nodes_no_hgnc, "hgncName") - expect_true(all(grepl("P53_HUMAN|MDM2_HUMAN|ATM_HUMAN|BRCA1_HUMAN", elements_fallback))) -}) \ No newline at end of file diff --git a/vignettes/Cytoscape-Visualization.Rmd b/vignettes/Cytoscape-Visualization.Rmd index 47837e1..2f0e128 100644 --- a/vignettes/Cytoscape-Visualization.Rmd +++ b/vignettes/Cytoscape-Visualization.Rmd @@ -1,6 +1,12 @@ --- -title: "Cytoscape-Visualization" -output: html_document +title: "Visualization Engine with CytoscapeJS" +author: "Anthony Wu" +package: MSstatsBioNet +output: BiocStyle::html_document +vignette: > + %\VignetteIndexEntry{MSstatsBioNet: Visualization Engine with CytoscapeJS} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} --- ```{r} diff --git a/vignettes/PTM-Analysis.Rmd b/vignettes/PTM-Analysis.Rmd index d86e23c..10d43ca 100644 --- a/vignettes/PTM-Analysis.Rmd +++ b/vignettes/PTM-Analysis.Rmd @@ -16,7 +16,6 @@ knitr::opts_chunk$set( ) ``` - # Installation Run this code below to install MSstatsBioNet from bioconductor @@ -31,7 +30,7 @@ BiocManager::install("MSstatsBioNet") ## Dataset -We will be taking a subset of the dataset found in this [paper](https://www.biorxiv.org/content/10.1101/2024.10.21.619348v1). The table is the output of the MSstatsPTM function `groupComparisonPTM` (filtered down to the columns that are actually needed) +We will be taking a subset of the dataset found in this [paper](https://www.biorxiv.org/content/10.1101/2024.10.21.619348v1). The table is the output of the MSstatsPTM function `groupComparisonPTM` (filtered down to the columns that are actually needed) ```{r} input = data.table::fread(system.file( @@ -43,12 +42,9 @@ head(input) ## ID Conversion -First, we need to convert the group comparison results to a format that can be -processed by INDRA. We can use the `annotateProteinInfoFromIndra` function -to obtain these mappings. +First, we need to convert the group comparison results to a format that can be processed by INDRA. We can use the `annotateProteinInfoFromIndra` function to obtain these mappings. -In the below example, we convert uniprot IDs to their corresponding Hgnc IDs. We -can also extract other information, such as hgnc gene name and protein function. +In the below example, we convert uniprot IDs to their corresponding Hgnc IDs. We can also extract other information, such as hgnc gene name and protein function. ```{r} library(MSstatsBioNet) @@ -58,9 +54,7 @@ head(annotated_df) ## Subnetwork Query -The package provides a function `getSubnetworkFromIndra` that retrieves a -subnetwork of proteins from the INDRA database based on differential abundance -analysis results. This function may help finding off target subnetworks. +The package provides a function `getSubnetworkFromIndra` that retrieves a subnetwork of proteins from the INDRA database based on differential abundance analysis results. This function may help finding off target subnetworks. ```{r} subnetwork <- getSubnetworkFromIndra(annotated_df, pvalueCutoff = 0.05, statement_types = c("Phosphorylation"), logfc_cutoff = 1, force_include_other = c("HGNC:3236"))