Feature html viz#53
Conversation
WalkthroughThis update introduces a new R script for exporting and visualizing networks as interactive Cytoscape.js HTML files. Three new public functions ( Changes
Sequence Diagram(s)sequenceDiagram
participant User
participant R_Package
participant Browser
User->>R_Package: Call exportNetworkToHTML(nodes, edges, ...)
R_Package->>R_Package: generateCytoscapeConfig(node_elements, edge_elements, ...)
R_Package->>R_Package: exportCytoscapeToHTML(config, filename, ...)
R_Package->>File: Write standalone HTML file
User->>R_Package: Optionally call previewNetworkInBrowser(nodes, edges, ...)
R_Package->>R_Package: Generate temp HTML
R_Package->>Browser: Open HTML file via browseURL
Estimated code review effort🎯 3 (Moderate) | ⏱️ ~20 minutes Poem
Note 🔌 MCP (Model Context Protocol) integration is now available in Early Access!Pro users can now connect to remote MCP servers under the Integrations page to get reviews and chat conversations that understand additional development context. ✨ Finishing Touches🧪 Generate unit tests
Thanks for using CodeRabbit! It's free for OSS, and your support helps us grow. If you like it, consider giving us a shout-out. 🪧 TipsChatThere are 3 ways to chat with CodeRabbit:
SupportNeed help? Create a ticket on our support page for assistance with any issues or questions. CodeRabbit Commands (Invoked using PR comments)
Other keywords and placeholders
CodeRabbit Configuration File (
|
PR Reviewer Guide 🔍Here are some key observations to aid the review process:
|
PR Code Suggestions ✨Explore these optional code suggestions:
|
There was a problem hiding this comment.
Actionable comments posted: 5
🔭 Outside diff range comments (1)
man/previewNetworkInBrowser.Rd (1)
18-21: Add missing return value documentation.The documentation is missing a
\valuesection. Even if the function is primarily called for its side effects (opening browser), it should document what it returns.Add a value section:
\item{...}{Additional arguments passed to exportCytoscapeToHTML()} } +\value{ +Invisibly returns the file path of the temporary HTML file (or NULL if no value returned) +} \description{
🧹 Nitpick comments (5)
man/exportNetworkToHTML.Rd (1)
15-18: Enhance data frame parameter documentation.Consider adding more specific details about the expected structure and required columns for the
nodesandedgesdata frames to help users understand the input requirements.Example enhancement:
-\item{nodes}{Data frame with node information} +\item{nodes}{Data frame with node information including required 'id' column and optional 'hgncName' column} -\item{edges}{Data frame with edge information} +\item{edges}{Data frame with edge information including 'source' and 'target' columns}man/previewNetworkInBrowser.Rd (1)
9-12: Consider enhancing data frame parameter documentation.Similar to
exportNetworkToHTML, thenodesandedgesparameter descriptions could be more specific about expected column structures.R/visualizeNetworksWithHTML.R (3)
316-320: Improve layout option merging to preserve defaultsThe current merging approach completely replaces default values. Consider using a safer merge that preserves defaults for unspecified options.
Use modifyList for safer merging:
# 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]] - } - } + layout_config <- if (!is.null(layout_options)) { + utils::modifyList(default_layout, layout_options) + } else { + default_layout + }
501-878: Consider breaking down this large functionThis function is 377 lines long, making it difficult to maintain and test. Consider extracting the HTML generation, CSS generation, and JavaScript generation into separate helper functions.
Break down into smaller functions:
generateHTMLHead()- for meta tags and script importsgenerateCSS()- for all CSS stylesgenerateLegendJS()- for legend creation JavaScriptgenerateControlsHTML()andgenerateControlsJS()- already partially separatedThis would improve maintainability and testability.
929-940: Consider adding temp file cleanup mechanismTemporary HTML files created by this function will accumulate over time. Consider implementing a cleanup mechanism or using
on.exit()to ensure cleanup in case of errors.Add optional cleanup:
previewNetworkInBrowser <- function(nodes, edges, displayLabelType = "id", + cleanup = FALSE, ...) { # Create elements node_elements <- createNodeElements(nodes, displayLabelType) edge_elements <- createEdgeElements(edges) # Generate configuration config <- generateCytoscapeConfig(node_elements, edge_elements) # Create temporary filename temp_file <- tempfile(fileext = ".html") + # Optional cleanup on exit + if (cleanup) { + on.exit(unlink(temp_file), add = TRUE) + } + # Export to temp file exportCytoscapeToHTML(config, temp_file, ...)
📜 Review details
Configuration used: CodeRabbit UI
Review profile: CHILL
Plan: Pro
📒 Files selected for processing (6)
NAMESPACE(3 hunks)R/visualizeNetworksWithHTML.R(1 hunks)man/exportNetworkToHTML.Rd(1 hunks)man/generateCytoscapeConfig.Rd(1 hunks)man/generateJavaScriptCode.Rd(1 hunks)man/previewNetworkInBrowser.Rd(1 hunks)
🔇 Additional comments (9)
NAMESPACE (2)
4-8: LGTM! Well-structured API additions.The new exports are logically grouped and maintain alphabetical ordering. The three functions provide a clear progression: generate config → export to HTML → preview in browser.
21-22: Appropriate base R imports for visualization utilities.The imports from
grDevices(colorRamp, rgb) andutils(browseURL) are well-chosen for color mapping and browser integration respectively. Using base R packages avoids additional dependencies.Also applies to: 34-34
man/generateJavaScriptCode.Rd (1)
1-18: LGTM! Appropriate documentation for internal function.The documentation correctly identifies this as an internal function with concise but clear parameter and return value descriptions. Good practice to document internal utilities even when not exported.
man/exportNetworkToHTML.Rd (1)
22-22: LGTM! Clear parameter constraints.Good documentation of the specific valid values for
displayLabelTypeparameter ("id" or "hgncName").man/generateCytoscapeConfig.Rd (3)
26-33: LGTM! Comprehensive return value documentation.Excellent detailed documentation of the returned list structure with clear descriptions of each component. The inclusion of
js_codefor backward compatibility is well noted.
34-38: LGTM! Clear architectural description.Good description emphasizing the decoupling from UI frameworks, which promotes reusability and modularity.
16-18: Helper functions verified – documentation is accurate.The referenced
createNodeElements()andcreateEdgeElements()helpers are implemented inR/visualizeNetworksWithHTML.R(lines 218 and 245). No changes needed.R/visualizeNetworksWithHTML.R (2)
20-29: Potential division by zero in edge caseWhile the function handles the case where all non-NA values are the same (line 15), there's still a potential division by zero if
max_logFCequalsmin_logFCafter the default_max calculation. This could happen if all absolute values equal exactly the default_max.Consider adding a check after computing min/max:
max_logFC <- max(c(abs(logFC_values), default_max), na.rm = TRUE) min_logFC <- -1 * max_logFC + # Additional safety check + if (max_logFC == min_logFC) { + return(rep("#D3D3D3", length(logFC_values))) + } + # Create color mapping functionLikely an incorrect or invalid review comment.
861-863: Fix incorrect escape sequence in error handlingThe escape sequence
\\"will produce literal backslashes in the HTML output, which will cause JavaScript syntax errors.Use proper escaping:
document.getElementById("', config$container_id, '").innerHTML = - "<div style=\\"padding: 20px; text-align: center; color: red;\\">"+ - "Error loading visualization: " + error.message + "</div>"; + "<div style=\'padding: 20px; text-align: center; color: red;\'>"+ + "Error loading visualization: " + error.message + "</div>";Likely an incorrect or invalid review comment.
| # ============================================================================= | ||
| # CYTOSCAPE VISUALIZATION PACKAGE FUNCTIONS | ||
| # These functions should go in your separate package | ||
| # ============================================================================= | ||
|
|
||
| #' 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" | ||
| ) | ||
| ) | ||
| } | ||
|
|
||
| # Consolidate bidirectional edges based on relationship type | ||
| consolidateEdges <- function(edges) { | ||
| 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 = ", ")) | ||
| } | ||
|
|
||
| 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 = "-") | ||
| reverse_key <- paste(sort(c(edge$source, edge$target), decreasing = TRUE), edge$interaction, sep = "-") | ||
|
|
||
| # 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 | ||
|
|
||
| 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, | ||
| 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, | ||
| 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 <- paste(edge$source, edge$target, consolidated_edge$interaction, sep = "-") | ||
| consolidated_edges[[edge_key]] <- 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 | ||
|
|
||
| edge_key <- paste(edge$source, edge$target, edge$interaction, sep = "-") | ||
| consolidated_edges[[edge_key]] <- 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") { | ||
| # Map logFC to colors if logFC column exists | ||
| if ("logFC" %in% names(nodes)) { | ||
| node_colors <- mapLogFCToColor(nodes$logFC) | ||
| } else { | ||
| node_colors <- rep("#D3D3D3", nrow(nodes)) # Default color | ||
| } | ||
|
|
||
| # Determine which column to use for labels | ||
| label_column <- if(displayLabelType == "hgncName" && "hgncName" %in% names(nodes)) { | ||
| "hgncName" | ||
| } else { | ||
| "id" | ||
| } | ||
|
|
||
| apply(cbind(nodes, color = node_colors), 1, function(row) { | ||
| # Use the appropriate label, fallback to id if hgncName is missing/empty | ||
| display_label <- if(label_column == "hgncName" && !is.na(row['hgncName']) && row['hgncName'] != "") { | ||
| row['hgncName'] | ||
| } else { | ||
| row['id'] | ||
| } | ||
|
|
||
| paste0("{ data: { id: '", row['id'], "', label: '", display_label, "', color: '", row['color'], "' } }") | ||
| }) | ||
| } | ||
|
|
||
| createEdgeElements <- function(edges) { | ||
| if (nrow(edges) == 0) return(list()) | ||
|
|
||
| # First consolidate edges | ||
| consolidated_edges <- consolidateEdges(edges) | ||
|
|
||
| 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) | ||
|
|
||
| # Create edge data with styling information | ||
| edge_data <- paste0("{ data: { source: '", row$source, | ||
| "', target: '", row$target, | ||
| "', id: '", edge_key, | ||
| "', interaction: '", row$interaction, | ||
| "', edge_type: '", row$edge_type, | ||
| "', category: '", row$category, | ||
| "', color: '", style$color, | ||
| "', line_style: '", style$style, | ||
| "', arrow_shape: '", style$arrow, | ||
| "', width: ", style$width, " } }") | ||
|
|
||
| edge_elements[[edge_key]] <- edge_data | ||
| } | ||
|
|
||
| return(edge_elements) | ||
| } | ||
|
|
||
| #' 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 node_elements List of node elements created by createNodeElements() | ||
| #' @param edge_elements List of edge elements created by createEdgeElements() | ||
| #' @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(node_elements, edge_elements, | ||
| container_id = "network-cy", | ||
| event_handlers = NULL, | ||
| layout_options = NULL) { | ||
|
|
||
| # 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 (same as before) | ||
| 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` = "11px", | ||
| `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` = "9px", | ||
| `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" | ||
| ) | ||
| ) | ||
| ) | ||
|
|
||
| # 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, " | ||
| }); | ||
|
|
||
| ", 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 | ||
| #' node_elements <- createNodeElements(nodes) | ||
| #' edge_elements <- createEdgeElements(edges) | ||
| #' 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 <- ' | ||
| <div id="controls" style="margin-bottom: 10px;"> | ||
| <button id="fit-btn" class="control-btn">Fit to Screen</button> | ||
| <button id="center-btn" class="control-btn">Center</button> | ||
| <button id="zoom-in-btn" class="control-btn">Zoom In</button> | ||
| <button id="zoom-out-btn" class="control-btn">Zoom Out</button> | ||
| <button id="reset-btn" class="control-btn">Reset View</button> | ||
| </div>' | ||
|
|
||
| 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; | ||
| }' | ||
|
|
||
| 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(); | ||
| });' | ||
| } | ||
|
|
||
| # Create the complete HTML content | ||
| html_content <- paste0('<!DOCTYPE html> | ||
| <html lang="en"> | ||
| <head> | ||
| <meta charset="UTF-8"> | ||
| <meta name="viewport" content="width=device-width, initial-scale=1.0"> | ||
| <title>', title, '</title> | ||
|
|
||
| <!-- Cytoscape.js and dependencies --> | ||
| <script src="https://cdnjs.cloudflare.com/ajax/libs/cytoscape/3.32.0/cytoscape.min.js"></script> | ||
| <script src="https://cdnjs.cloudflare.com/ajax/libs/graphlib/2.1.8/graphlib.min.js"></script> | ||
| <script src="https://cdnjs.cloudflare.com/ajax/libs/dagre/0.8.5/dagre.min.js"></script> | ||
| <script src="https://unpkg.com/cytoscape-dagre@2.3.0/cytoscape-dagre.js"></script> | ||
|
|
||
| <style> | ||
| body { | ||
| font-family: Arial, sans-serif; | ||
| margin: 0; | ||
| padding: 20px; | ||
| background-color: #f5f5f5; | ||
| } | ||
|
|
||
| .container { | ||
| max-width: 1200px; | ||
| margin: 0 auto; | ||
| background-color: white; | ||
| border-radius: 8px; | ||
| box-shadow: 0 2px 10px rgba(0,0,0,0.1); | ||
| padding: 20px; | ||
| } | ||
|
|
||
| h1 { | ||
| color: #333; | ||
| text-align: center; | ||
| margin-bottom: 20px; | ||
| } | ||
|
|
||
| #' | ||
| , config$container_id, ' { | ||
| width: ', width, '; | ||
| height: ', height, '; | ||
| border: 1px solid #ddd; | ||
| border-radius: 4px; | ||
| background-color: #fff; | ||
| } | ||
|
|
||
| #legend { | ||
| background-color: #f8f9fa; | ||
| border: 1px solid #dee2e6; | ||
| border-radius: 4px; | ||
| padding: 15px; | ||
| } | ||
|
|
||
| .legend-title { | ||
| font-weight: bold; | ||
| margin-bottom: 10px; | ||
| font-size: 14px; | ||
| color: #333; | ||
| } | ||
|
|
||
| .legend-item { | ||
| display: flex; | ||
| align-items: center; | ||
| margin-bottom: 8px; | ||
| font-size: 12px; | ||
| } | ||
|
|
||
| .legend-color { | ||
| width: 20px; | ||
| height: 20px; | ||
| border: 2px solid #333; | ||
| border-radius: 3px; | ||
| margin-right: 8px; | ||
| } | ||
|
|
||
| .legend-gradient { | ||
| height: 120px; | ||
| width: 20px; | ||
| border: 2px solid #333; | ||
| border-radius: 3px; | ||
| margin-right: 8px; | ||
| background: linear-gradient(to top, #ADD8E6, #D3D3D3, #FFA590); | ||
| } | ||
|
|
||
| .legend-gradient-labels { | ||
| display: flex; | ||
| flex-direction: column; | ||
| justify-content: space-between; | ||
| height: 120px; | ||
| font-size: 11px; | ||
| } | ||
|
|
||
| .edge-legend { | ||
| margin-top: 20px; | ||
| } | ||
|
|
||
| .edge-legend-item { | ||
| display: flex; | ||
| align-items: center; | ||
| margin-bottom: 6px; | ||
| font-size: 11px; | ||
| } | ||
|
|
||
| .edge-legend-line { | ||
| width: 30px; | ||
| height: 2px; | ||
| margin-right: 8px; | ||
| } | ||
|
|
||
| ', controls_css, ' | ||
|
|
||
| ', custom_css, ' | ||
|
|
||
| .info-panel { | ||
| margin-top: 15px; | ||
| padding: 10px; | ||
| background-color: #f8f9fa; | ||
| border: 1px solid #dee2e6; | ||
| border-radius: 4px; | ||
| font-size: 12px; | ||
| color: #666; | ||
| } | ||
| </style> | ||
| </head> | ||
| <body> | ||
| <div class="container"> | ||
| <h1>', title, '</h1> | ||
|
|
||
| ', controls_html, ' | ||
|
|
||
| <div style="display: flex; gap: 20px;"> | ||
| <div id="', config$container_id, '" style="flex: 1;"></div> | ||
| <div id="legend" style="width: 200px; flex-shrink: 0;"> | ||
| <!-- Legend will be populated by JavaScript --> | ||
| </div> | ||
| </div> | ||
|
|
||
| <div class="info-panel"> | ||
| <strong>Instructions:</strong> | ||
| Click and drag to pan the network | ||
| | Use mouse wheel to zoom in/out | ||
| | Click on nodes or edges to select them | ||
| ', if(include_controls) '| Use the buttons above for common navigation actions' else '', ' | ||
| </div> | ||
| </div> | ||
|
|
||
| <script> | ||
| // Function to create the legend | ||
| function createLegend(cy) { | ||
| const legendDiv = document.getElementById("legend"); | ||
|
|
||
| // Check if nodes have logFC data | ||
| const nodes = cy.nodes(); | ||
| let hasLogFC = false; | ||
| let logFCValues = []; | ||
|
|
||
| nodes.forEach(function(node) { | ||
| const nodeData = node.data(); | ||
| // Try to extract logFC from color or check if we can determine logFC values | ||
| // Since we only have access to the final colors, we\'ll create a standard legend | ||
| hasLogFC = true; // Assume we have logFC if we\'re showing the legend | ||
| }); | ||
|
|
||
| let legendHTML = ""; | ||
|
|
||
| if (hasLogFC) { | ||
| legendHTML += ` | ||
| <div class="legend-title">Node Colors (logFC)</div> | ||
| <div class="legend-item"> | ||
| <div class="legend-gradient"></div> | ||
| <div class="legend-gradient-labels"> | ||
| <div>Upregulated</div> | ||
| <div>Neutral (0)</div> | ||
| <div>Downregulated</div> | ||
| </div> | ||
| </div> | ||
| <div style="margin-top: 10px; font-size: 10px; color: #666;"> | ||
| Log Fold Change values | ||
| </div> | ||
| `; | ||
| } else { | ||
| legendHTML += ` | ||
| <div class="legend-title">Node Colors</div> | ||
| <div class="legend-item"> | ||
| <div class="legend-color" style="background-color: #D3D3D3;"></div> | ||
| <span>Default</span> | ||
| </div> | ||
| `; | ||
| } | ||
|
|
||
| // Add edge legend | ||
| legendHTML += ` | ||
| <div class="edge-legend"> | ||
| <div class="legend-title">Edge Types</div> | ||
| <div class="edge-legend-item"> | ||
| <div class="edge-legend-line" style="background-color: #44AA44;"></div> | ||
| <span>Activation</span> | ||
| </div> | ||
| <div class="edge-legend-item"> | ||
| <div class="edge-legend-line" style="background-color: #FF4444;"></div> | ||
| <span>Inhibition</span> | ||
| </div> | ||
| <div class="edge-legend-item"> | ||
| <div class="edge-legend-line" style="background-color: #4488FF;"></div> | ||
| <span>Increase Amount</span> | ||
| </div> | ||
| <div class="edge-legend-item"> | ||
| <div class="edge-legend-line" style="background-color: #FF8844;"></div> | ||
| <span>Decrease Amount</span> | ||
| </div> | ||
| <div class="edge-legend-item"> | ||
| <div class="edge-legend-line" style="background-color: #9932CC; border-style: dashed; border-width: 1px; height: 0px; border-top-width: 2px;"></div> | ||
| <span>Phosphorylation</span> | ||
| </div> | ||
| <div class="edge-legend-item"> | ||
| <div class="edge-legend-line" style="background-color: #8B4513;"></div> | ||
| <span>Complex</span> | ||
| </div> | ||
| </div> | ||
| `; | ||
|
|
||
| legendDiv.innerHTML = legendHTML; | ||
| } | ||
|
|
||
| // Wait for DOM to be fully loaded | ||
| document.addEventListener("DOMContentLoaded", function() { | ||
| try { | ||
| // Initialize Cytoscape | ||
| ', config$js_code, ' | ||
|
|
||
| // Add basic interactivity | ||
| cy.on("tap", "node", function(evt) { | ||
| var node = evt.target; | ||
| console.log("Node clicked:", node.data()); | ||
| }); | ||
|
|
||
| cy.on("tap", "edge", function(evt) { | ||
| var edge = evt.target; | ||
| console.log("Edge clicked:", edge.data()); | ||
| }); | ||
|
|
||
| ', controls_js, ' | ||
|
|
||
| // Create legend | ||
| createLegend(cy); | ||
|
|
||
| ', custom_js, ' | ||
|
|
||
| console.log("Network visualization loaded successfully!"); | ||
|
|
||
| } catch (error) { | ||
| console.error("Error loading network visualization:", error); | ||
| document.getElementById("', config$container_id, '").innerHTML = | ||
| "<div style=\\"padding: 20px; text-align: center; color: red;\\">"+ | ||
| "Error loading visualization: " + error.message + "</div>"; | ||
| } | ||
| }); | ||
| </script> | ||
| </body> | ||
| </html>') | ||
|
|
||
| # 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)) | ||
| } | ||
|
|
||
| #' 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 ... 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", | ||
| ...) { | ||
|
|
||
| # Create elements | ||
| node_elements <- createNodeElements(nodes, displayLabelType) | ||
| edge_elements <- createEdgeElements(edges) | ||
|
|
||
| # Generate configuration | ||
| config <- generateCytoscapeConfig(node_elements, edge_elements) | ||
|
|
||
| # 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", | ||
| ...) { | ||
|
|
||
| # Create elements | ||
| node_elements <- createNodeElements(nodes, displayLabelType) | ||
| edge_elements <- createEdgeElements(edges) | ||
|
|
||
| # Generate configuration | ||
| config <- generateCytoscapeConfig(node_elements, edge_elements) | ||
|
|
||
| # 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 |
There was a problem hiding this comment.
🛠️ Refactor suggestion
Add unit tests for the new visualization functions
This file introduces significant new functionality but doesn't include any unit tests. Consider adding tests to verify:
- Color mapping edge cases in
mapLogFCToColor - Edge consolidation logic in
consolidateEdges - JavaScript/HTML generation and escaping
- File export functionality
Would you like me to help generate a comprehensive test suite for these functions?
🤖 Prompt for AI Agents
In R/visualizeNetworksWithHTML.R covering the entire file (lines 1-941), the new
visualization functions lack unit tests. To fix this, create a test suite using
a testing framework like testthat that includes tests for mapLogFCToColor
covering normal and edge cases (e.g., all NA, uniform values), consolidateEdges
verifying correct merging of bidirectional edges and handling of missing
columns, generateJavaScriptCode and exportCytoscapeToHTML ensuring proper
JavaScript/HTML output and escaping, and file export functions confirming files
are created and contain expected content. This will improve code reliability and
maintainability.
| reverse_key <- paste(sort(c(edge$source, edge$target), decreasing = TRUE), edge$interaction, sep = "-") | ||
|
|
There was a problem hiding this comment.
🛠️ Refactor suggestion
Unused variable and potential edge processing issue
The reverse_key variable on line 100 is created but never used. Additionally, the logic for tracking processed pairs may not correctly handle all edge cases.
Remove the unused variable:
pair_key <- paste(sort(c(edge$source, edge$target)), edge$interaction, collapse = "-")
- reverse_key <- paste(sort(c(edge$source, edge$target), decreasing = TRUE), edge$interaction, sep = "-")Also applies to: 155-155
🤖 Prompt for AI Agents
In R/visualizeNetworksWithHTML.R at lines 99-100 and also line 155, remove the
unused variable `reverse_key` since it is created but never used. Review the
logic for tracking processed edge pairs to ensure it correctly handles all cases
without relying on this variable, and adjust the code accordingly to avoid
potential edge processing issues.
| apply(cbind(nodes, color = node_colors), 1, function(row) { | ||
| # Use the appropriate label, fallback to id if hgncName is missing/empty | ||
| display_label <- if(label_column == "hgncName" && !is.na(row['hgncName']) && row['hgncName'] != "") { | ||
| row['hgncName'] | ||
| } else { | ||
| row['id'] | ||
| } | ||
|
|
||
| paste0("{ data: { id: '", row['id'], "', label: '", display_label, "', color: '", row['color'], "' } }") | ||
| }) |
There was a problem hiding this comment.
Security: Escape special characters to prevent JavaScript injection
The function directly concatenates user data into JavaScript strings without escaping special characters. This could lead to JavaScript injection if node IDs or labels contain quotes or other special characters.
Add proper escaping:
apply(cbind(nodes, color = node_colors), 1, function(row) {
# Use the appropriate label, fallback to id if hgncName is missing/empty
display_label <- if(label_column == "hgncName" && !is.na(row['hgncName']) && row['hgncName'] != "") {
row['hgncName']
} else {
row['id']
}
+ # Escape special characters for JavaScript
+ escaped_id <- gsub("['\"\\\\]", "\\\\\\0", row['id'])
+ escaped_label <- gsub("['\"\\\\]", "\\\\\\0", display_label)
+ escaped_color <- gsub("['\"\\\\]", "\\\\\\0", row['color'])
+
- paste0("{ data: { id: '", row['id'], "', label: '", display_label, "', color: '", row['color'], "' } }")
+ paste0("{ data: { id: '", escaped_id, "', label: '", escaped_label, "', color: '", escaped_color, "' } }")
})🤖 Prompt for AI Agents
In R/visualizeNetworksWithHTML.R around lines 233 to 242, the code directly
concatenates node IDs and labels into JavaScript strings without escaping
special characters, risking JavaScript injection. To fix this, implement a
function to escape special characters like quotes and backslashes in these
values before concatenation. Replace direct usage of row['id'], display_label,
and row['color'] with their escaped versions to ensure safe embedding in
JavaScript code.
| edge_data <- paste0("{ data: { source: '", row$source, | ||
| "', target: '", row$target, | ||
| "', id: '", edge_key, | ||
| "', interaction: '", row$interaction, | ||
| "', edge_type: '", row$edge_type, | ||
| "', category: '", row$category, | ||
| "', color: '", style$color, | ||
| "', line_style: '", style$style, | ||
| "', arrow_shape: '", style$arrow, | ||
| "', width: ", style$width, " } }") |
There was a problem hiding this comment.
Security: Escape special characters in edge data
Similar to the node elements, edge data should be properly escaped to prevent JavaScript injection.
Add escaping for all string values being inserted into JavaScript:
+ # Escape special characters
+ escaped_source <- gsub("['\"\\\\]", "\\\\\\0", row$source)
+ escaped_target <- gsub("['\"\\\\]", "\\\\\\0", row$target)
+ escaped_key <- gsub("['\"\\\\]", "\\\\\\0", edge_key)
+ escaped_interaction <- gsub("['\"\\\\]", "\\\\\\0", row$interaction)
+
# Create edge data with styling information
- edge_data <- paste0("{ data: { source: '", row$source,
- "', target: '", row$target,
- "', id: '", edge_key,
- "', interaction: '", row$interaction,
+ edge_data <- paste0("{ data: { source: '", escaped_source,
+ "', target: '", escaped_target,
+ "', id: '", escaped_key,
+ "', interaction: '", escaped_interaction,
"', edge_type: '", row$edge_type,
"', category: '", row$category,
"', color: '", style$color,📝 Committable suggestion
‼️ IMPORTANT
Carefully review the code before committing. Ensure that it accurately replaces the highlighted code, contains no missing lines, and has no issues with indentation. Thoroughly test & benchmark the code to ensure it meets the requirements.
| edge_data <- paste0("{ data: { source: '", row$source, | |
| "', target: '", row$target, | |
| "', id: '", edge_key, | |
| "', interaction: '", row$interaction, | |
| "', edge_type: '", row$edge_type, | |
| "', category: '", row$category, | |
| "', color: '", style$color, | |
| "', line_style: '", style$style, | |
| "', arrow_shape: '", style$arrow, | |
| "', width: ", style$width, " } }") | |
| # Escape special characters | |
| escaped_source <- gsub("['\"\\\\]", "\\\\\\0", row$source) | |
| escaped_target <- gsub("['\"\\\\]", "\\\\\\0", row$target) | |
| escaped_key <- gsub("['\"\\\\]", "\\\\\\0", edge_key) | |
| escaped_interaction <- gsub("['\"\\\\]", "\\\\\\0", row$interaction) | |
| # Create edge data with styling information | |
| edge_data <- paste0("{ data: { source: '", escaped_source, | |
| "', target: '", escaped_target, | |
| "', id: '", escaped_key, | |
| "', interaction: '", escaped_interaction, | |
| "', edge_type: '", row$edge_type, | |
| "', category: '", row$category, | |
| "', color: '", style$color, | |
| "', line_style: '", style$style, | |
| "', arrow_shape: '", style$arrow, | |
| "', width: ", style$width, " } }") |
🤖 Prompt for AI Agents
In R/visualizeNetworksWithHTML.R around lines 261 to 270, the edge data strings
are directly inserted into JavaScript without escaping, risking injection
attacks. Fix this by applying proper escaping to all string values (like source,
target, interaction, edge_type, category, color, line_style, arrow_shape) before
concatenation, ensuring special characters are safely encoded to prevent
JavaScript injection vulnerabilities.
| 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 ") |
There was a problem hiding this comment.
Validate event handler code to prevent code injection
Event handler code is directly inserted into JavaScript without validation. This could allow arbitrary code execution if the handlers contain malicious code.
Consider adding validation or sanitization:
if (!is.null(config$event_handlers)) {
+ # Validate that handlers are functions or safe strings
+ for (handler_name in names(config$event_handlers)) {
+ handler_code <- config$event_handlers[[handler_name]]
+ if (!is.character(handler_code) || grepl("(eval|Function|setTimeout|setInterval)", handler_code)) {
+ warning(paste("Potentially unsafe event handler:", handler_name))
+ }
+ }
handlers <- sapply(names(config$event_handlers), function(event) {📝 Committable suggestion
‼️ IMPORTANT
Carefully review the code before committing. Ensure that it accurately replaces the highlighted code, contains no missing lines, and has no issues with indentation. Thoroughly test & benchmark the code to ensure it meets the requirements.
| 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 ") | |
| if (!is.null(config$event_handlers)) { | |
| # Validate that handlers are functions or safe strings | |
| for (handler_name in names(config$event_handlers)) { | |
| handler_code <- config$event_handlers[[handler_name]] | |
| if (!is.character(handler_code) || grepl("(eval|Function|setTimeout|setInterval)", handler_code)) { | |
| warning(paste("Potentially unsafe event handler:", handler_name)) | |
| } | |
| } | |
| 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 ") | |
| } |
🤖 Prompt for AI Agents
In R/visualizeNetworksWithHTML.R around lines 428 to 437, the event handler code
from config$event_handlers is directly inserted into JavaScript, risking code
injection. To fix this, implement validation or sanitization of the handler_code
before embedding it in the JavaScript string. This can include checking for
allowed patterns, escaping special characters, or restricting the input to safe
predefined functions to prevent arbitrary code execution.
Codecov Report❌ Patch coverage is
Additional details and impacted files@@ Coverage Diff @@
## devel #53 +/- ##
===========================================
- Coverage 64.71% 32.08% -32.63%
===========================================
Files 7 8 +1
Lines 598 1206 +608
===========================================
Hits 387 387
- Misses 211 819 +608 ☔ View full report in Codecov by Sentry. 🚀 New features to boost your workflow:
|
Checklist Before Requesting a Review
PR Type
Enhancement, Documentation
Description
Add HTML export & preview functions
Implement color mapping & styling utils
Update NAMESPACE exports & imports
Provide Rd docs for new functions
Diagram Walkthrough
File Walkthrough
NAMESPACE
Update exports and imports for HTML vizNAMESPACE
visualizeNetworksWithHTML.R
Add Cytoscape HTML visualization functionsR/visualizeNetworksWithHTML.R
exportNetworkToHTML.Rd
Document exportNetworkToHTMLman/exportNetworkToHTML.Rd
generateCytoscapeConfig.Rd
Document generateCytoscapeConfigman/generateCytoscapeConfig.Rd
generateJavaScriptCode.Rd
Document generateJavaScriptCodeman/generateJavaScriptCode.Rd
previewNetworkInBrowser.Rd
Document previewNetworkInBrowserman/previewNetworkInBrowser.Rd