Skip to content

Feature html viz#53

Merged
tonywu1999 merged 5 commits intodevelfrom
feature-html-viz
Aug 7, 2025
Merged

Feature html viz#53
tonywu1999 merged 5 commits intodevelfrom
feature-html-viz

Conversation

@tonywu1999
Copy link
Copy Markdown
Contributor

@tonywu1999 tonywu1999 commented Aug 7, 2025

Checklist Before Requesting a Review

  • I have read the MSstats contributing guidelines
  • My changes generate no new warnings
  • Any dependent changes have been merged and published in downstream modules
  • Ran styler::style_pkg(transformers = styler::tidyverse_style(indent_by = 4))
  • Ran devtools::document()

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

flowchart LR
  data["Nodes & Edges Data"]
  elements["createNodeElements & createEdgeElements"]
  config["generateCytoscapeConfig"]
  html["exportCytoscapeToHTML"]
  preview["previewNetworkInBrowser"]

  data --> elements
  elements --> config
  config --> html
  html --> preview
Loading

File Walkthrough

Relevant files
Configuration changes
NAMESPACE
Update exports and imports for HTML viz                                   

NAMESPACE

  • Export new HTML viz functions
  • Import grDevices::colorRamp, rgb
  • Import utils::browseURL
+6/-0     
Enhancement
visualizeNetworksWithHTML.R
Add Cytoscape HTML visualization functions                             

R/visualizeNetworksWithHTML.R

  • Add mapLogFCToColor for node coloring
  • Define relationship props & edge consolidation
  • Create node/edge element & style config functions
  • Implement export & preview HTML functions
+941/-0 
Documentation
exportNetworkToHTML.Rd
Document exportNetworkToHTML                                                         

man/exportNetworkToHTML.Rd

  • Add documentation for exportNetworkToHTML
+32/-0   
generateCytoscapeConfig.Rd
Document generateCytoscapeConfig                                                 

man/generateCytoscapeConfig.Rd

  • Add documentation for generateCytoscapeConfig
+38/-0   
generateJavaScriptCode.Rd
Document generateJavaScriptCode                                                   

man/generateJavaScriptCode.Rd

  • Add documentation for generateJavaScriptCode
+17/-0   
previewNetworkInBrowser.Rd
Document previewNetworkInBrowser                                                 

man/previewNetworkInBrowser.Rd

  • Add documentation for previewNetworkInBrowser
+20/-0   

@coderabbitai
Copy link
Copy Markdown

coderabbitai Bot commented Aug 7, 2025

Walkthrough

This update introduces a new R script for exporting and visualizing networks as interactive Cytoscape.js HTML files. Three new public functions (exportNetworkToHTML, generateCytoscapeConfig, previewNetworkInBrowser) are added, with corresponding documentation and NAMESPACE exports. Additional package dependencies for color and browser utilities are declared.

Changes

Cohort / File(s) Change Summary
NAMESPACE and Imports
NAMESPACE
Added exports for exportNetworkToHTML, generateCytoscapeConfig, and previewNetworkInBrowser. Imported colorRamp and rgb from grDevices, and browseURL from utils.
Cytoscape Visualization Functions
R/visualizeNetworksWithHTML.R
Introduced a new script implementing functions for generating Cytoscape.js configuration, exporting to HTML, mapping node/edge attributes to styles, and providing browser preview. Added helper utilities for color mapping, edge consolidation, and legend generation. Main functions include generateCytoscapeConfig, exportCytoscapeToHTML, exportNetworkToHTML, and previewNetworkInBrowser.
Documentation: exportNetworkToHTML
man/exportNetworkToHTML.Rd
Added documentation for exportNetworkToHTML, describing its parameters, usage, and return value as a convenience wrapper for exporting network data to HTML.
Documentation: generateCytoscapeConfig
man/generateCytoscapeConfig.Rd
Added documentation for generateCytoscapeConfig, detailing its arguments, expected input/output, and purpose as a Cytoscape configuration generator.
Documentation: generateJavaScriptCode
man/generateJavaScriptCode.Rd
Added documentation for generateJavaScriptCode, an internal function for converting configuration objects to JavaScript code.
Documentation: previewNetworkInBrowser
man/previewNetworkInBrowser.Rd
Added documentation for previewNetworkInBrowser, describing its usage for temporary HTML preview of network data in a browser.

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
Loading

Estimated code review effort

🎯 3 (Moderate) | ⏱️ ~20 minutes

Poem

In the meadow of code, new networks now gleam,
HTML and Cytoscape—what a sparkling team!
With colors and legends, the nodes proudly show,
Edges entwine in a browser's warm glow.
Hop, hop, hooray!—visualizations take flight,
A rabbit’s delight, in pixels so bright.
🐇✨

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
  • Create PR with unit tests
  • Post copyable unit tests in a comment
  • Commit unit tests in branch feature-html-viz

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.

❤️ Share
🪧 Tips

Chat

There are 3 ways to chat with CodeRabbit:

  • Review comments: Directly reply to a review comment made by CodeRabbit. Example:
    • I pushed a fix in commit <commit_id>, please review it.
    • Explain this complex logic.
    • Open a follow-up GitHub issue for this discussion.
  • Files and specific lines of code (under the "Files changed" tab): Tag @coderabbitai in a new review comment at the desired location with your query. Examples:
    • @coderabbitai explain this code block.
  • PR comments: Tag @coderabbitai in a new PR comment to ask questions about the PR branch. For the best results, please provide a very specific query, as very limited context is provided in this mode. Examples:
    • @coderabbitai gather interesting stats about this repository and render them as a table. Additionally, render a pie chart showing the language distribution in the codebase.
    • @coderabbitai read src/utils.ts and explain its main purpose.
    • @coderabbitai read the files in the src/scheduler package and generate a class diagram using mermaid and a README in the markdown format.

Support

Need help? Create a ticket on our support page for assistance with any issues or questions.

CodeRabbit Commands (Invoked using PR comments)

  • @coderabbitai pause to pause the reviews on a PR.
  • @coderabbitai resume to resume the paused reviews.
  • @coderabbitai review to trigger an incremental review. This is useful when automatic reviews are disabled for the repository.
  • @coderabbitai full review to do a full review from scratch and review all the files again.
  • @coderabbitai summary to regenerate the summary of the PR.
  • @coderabbitai generate docstrings to generate docstrings for this PR.
  • @coderabbitai generate sequence diagram to generate a sequence diagram of the changes in this PR.
  • @coderabbitai generate unit tests to generate unit tests for this PR.
  • @coderabbitai resolve resolve all the CodeRabbit review comments.
  • @coderabbitai configuration to show the current CodeRabbit configuration for the repository.
  • @coderabbitai help to get help.

Other keywords and placeholders

  • Add @coderabbitai ignore anywhere in the PR description to prevent this PR from being reviewed.
  • Add @coderabbitai summary to generate the high-level summary at a specific location in the PR description.
  • Add @coderabbitai anywhere in the PR title to generate the title automatically.

CodeRabbit Configuration File (.coderabbit.yaml)

  • You can programmatically configure CodeRabbit by adding a .coderabbit.yaml file to the root of your repository.
  • Please see the configuration documentation for more information.
  • If your editor has YAML language server enabled, you can add the path at the top of this file to enable auto-completion and validation: # yaml-language-server: $schema=https://coderabbit.ai/integrations/schema.v2.json

Documentation and Community

  • Visit our Documentation for detailed information on how to use CodeRabbit.
  • Join our Discord Community to get help, request features, and share feedback.
  • Follow us on X/Twitter for updates and announcements.

@github-actions
Copy link
Copy Markdown
Contributor

github-actions Bot commented Aug 7, 2025

PR Reviewer Guide 🔍

Here are some key observations to aid the review process:

⏱️ Estimated effort to review: 5 🔵🔵🔵🔵🔵
🧪 No relevant tests
🔒 No security concerns identified
⚡ Recommended focus areas for review

Legend Detection

The createLegend JavaScript function unconditionally sets hasLogFC to true, leading to an incorrect gradient legend even when no logFC data is present.

// 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
HTML Injection Risk

User-supplied values (e.g., title, custom_css, custom_js) are concatenated directly into the HTML/JavaScript without escaping, which may cause injection or break the output.

    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 -->
Performance Concern

The consolidateEdges function loops over rows and filters inside the loop (O(n²) complexity), which may not scale for large networks.

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, ]

@github-actions
Copy link
Copy Markdown
Contributor

github-actions Bot commented Aug 7, 2025

PR Code Suggestions ✨

Explore these optional code suggestions:

CategorySuggestion                                                                                                                                    Impact
Possible issue
Correct edge key assembly

The current pair_key generation misplaces separators due to recycling of vectors in
paste, leading to malformed keys. Construct the key by collapsing a single
concatenated vector of source, target, and interaction to ensure consistent
formatting. Apply the same approach for reverse_key.

R/visualizeNetworksWithHTML.R [98]

-pair_key <- paste(sort(c(edge$source, edge$target)), edge$interaction, collapse = "-")
+pair_key <- paste(c(edge$source, edge$target, edge$interaction), collapse = "-")
Suggestion importance[1-10]: 8

__

Why: The original paste call produces malformed pair_key values, breaking bidirectional consolidation logic.

Medium
General
Clamp normalized values to [0,1]

To prevent out-of-range inputs to colorRamp, clamp normalized_values to the [0,1]
interval after normalization and before handling NA. This ensures color mapping
remains valid even if values slightly exceed the expected range.

R/visualizeNetworksWithHTML.R [28-31]

 normalized_values <- (logFC_values - min_logFC) / (max_logFC - min_logFC)
+normalized_values <- pmin(pmax(normalized_values, 0), 1)
 normalized_values[is.na(normalized_values)] <- 0.5  # Default to middle color
Suggestion importance[1-10]: 6

__

Why: Clamping prevents out-of-range values from causing unexpected colors or errors in colorRamp, enhancing robustness.

Low

Copy link
Copy Markdown

@coderabbitai coderabbitai Bot left a comment

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

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 \value section. 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 nodes and edges data 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, the nodes and edges parameter descriptions could be more specific about expected column structures.

R/visualizeNetworksWithHTML.R (3)

316-320: Improve layout option merging to preserve defaults

The 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 function

This 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 imports
  • generateCSS() - for all CSS styles
  • generateLegendJS() - for legend creation JavaScript
  • generateControlsHTML() and generateControlsJS() - already partially separated

This would improve maintainability and testability.


929-940: Consider adding temp file cleanup mechanism

Temporary 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

📥 Commits

Reviewing files that changed from the base of the PR and between 64d5eff and 48702d0.

📒 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) and utils (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 displayLabelType parameter ("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_code for 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() and createEdgeElements() helpers are implemented in R/visualizeNetworksWithHTML.R (lines 218 and 245). No changes needed.

R/visualizeNetworksWithHTML.R (2)

20-29: Potential division by zero in edge case

While 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_logFC equals min_logFC after 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 function

Likely an incorrect or invalid review comment.


861-863: Fix incorrect escape sequence in error handling

The 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.

Comment on lines +1 to +941
# =============================================================================
# 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
Copy link
Copy Markdown

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

🛠️ 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.

Comment on lines +99 to +100
reverse_key <- paste(sort(c(edge$source, edge$target), decreasing = TRUE), edge$interaction, sep = "-")

Copy link
Copy Markdown

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

🛠️ 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.

Comment on lines +233 to +242
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'], "' } }")
})
Copy link
Copy Markdown

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

⚠️ Potential issue

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.

Comment on lines +261 to +270
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, " } }")
Copy link
Copy Markdown

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

⚠️ Potential issue

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.

Suggested change
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.

Comment on lines +428 to +437
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 ")
Copy link
Copy Markdown

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

⚠️ Potential issue

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.

Suggested change
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-commenter
Copy link
Copy Markdown

Codecov Report

❌ Patch coverage is 0% with 608 lines in your changes missing coverage. Please review.
✅ Project coverage is 32.08%. Comparing base (64d5eff) to head (48702d0).

Files with missing lines Patch % Lines
R/visualizeNetworksWithHTML.R 0.00% 608 Missing ⚠️
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.
📢 Have feedback on the report? Share it here.

🚀 New features to boost your workflow:
  • ❄️ Test Analytics: Detect flaky tests, report on failures, and find test suite problems.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment

Labels

None yet

Projects

None yet

Development

Successfully merging this pull request may close these issues.

2 participants