I am working with the R programming language.

I have a data frame of cities and travel routes (all routes: latin america -> north america -> europe -> asia) – I made a graph network of this data:

library(igraph)

north_american_cities <- c("New York", "Los Angeles", "Chicago", "Houston", "Phoenix")
european_cities <- c("London", "Berlin", "Madrid", "Rome", "Paris")
asian_cities <- c("Tokyo", "Delhi", "Shanghai", "Beijing", "Mumbai")
latin_american_cities <- c("Lima", "Bogota", "Buenos Aires", "Sao Paulo", "Mexico City")

set.seed(123)
n <- 30
la_cities_sample <- sample(latin_american_cities, n, replace = TRUE)
na_cities_sample <- sample(north_american_cities, n, replace = TRUE)
eu_cities_sample <- sample(european_cities, n, replace = TRUE)
as_cities_sample <- sample(asian_cities, n, replace = TRUE)

df <- data.frame(LatinAmerica = la_cities_sample,
                 NorthAmerica = na_cities_sample,
                 Europe = eu_cities_sample,
                 Asia = as_cities_sample,
                 stringsAsFactors = FALSE)

df <- df[!duplicated(df), ]

edges_df <- data.frame(from = c(df$LatinAmerica, df$NorthAmerica, df$Europe),
                       to = c(df$NorthAmerica, df$Europe, df$Asia))

edge_list <- as.matrix(edges_df)

g <- graph_from_edgelist(edge_list, directed = TRUE)
plot(g)

From here, I wrote a function that takes any city, and finds all possible travel routes that go through this city from start to finish:

find_paths_through_city <- function(graph, target_city, path_length = 4) {
    all_paths <- all_simple_paths(graph, V(graph))
    
    valid_paths <- list()
    
    for (path in all_paths) {
        path_cities <- V(graph)[path]$name
        if (target_city %in% path_cities && length(path_cities) == path_length) {
            valid_paths <- append(valid_paths, list(path_cities))
        }
    }
    
    if (length(valid_paths) > 0) {
        paths_df <- do.call(rbind, lapply(valid_paths, function(x) as.data.frame(t(x), stringsAsFactors = FALSE)))
        colnames(paths_df) <- paste0("City", 1:path_length)
    } else {
        paths_df <- data.frame(matrix(ncol = path_length, nrow = 0))
        colnames(paths_df) <- paste0("City", 1:path_length)
    }
    
    return(paths_df)
}

Here, I tested this function for a specific city:

city <- "New York"  
paths_through_city <- find_paths_through_city(g, target_city = city, path_length = 4)
unique_cities <- unique(as.vector(as.matrix(paths_through_city)))
subgraph <- induced_subgraph(g, vids = unique_cities)
plot(subgraph, vertex.size=10, vertex.label.cex=0.8, edge.arrow.size=0.5, main=paste("Subgraph of Paths Passing Through", city))

My Question: From here, I want to make an interactive graph that allows the user to click on a given node in the graph using Visnetwork, and then highlights all possible travel routes passing through that node.

My friends and I tried to learn about how to do this today – we tried to write a javascript function to do this and got partway through:

nodes <- data.frame(id = V(g)$name, label = V(g)$name, stringsAsFactors = FALSE)
edges <- data.frame(from = edges_df$from, to = edges_df$to, stringsAsFactors = FALSE)

highlight_js <- '
function(params) {
  if (params.nodes.length == 0) return;

  var selectedNode = params.nodes[0];
  var pathLength = 4; 

  var graph = this.body.data;
  var allNodes = graph.nodes.get();
  var allEdges = graph.edges.get();

  var validPaths = [];
  function findPaths(currentPath, currentNode, depth) {
    if (depth == pathLength) {
      validPaths.push(currentPath.slice());
      return;
    }

    var connectedEdges = allEdges.filter(function(edge) {
      return edge.from == currentNode;
    });

    connectedEdges.forEach(function(edge) {
      findPaths(currentPath.concat(edge.to), edge.to, depth + 1);
    });
  }

  findPaths([selectedNode], selectedNode, 1);

  var nodesToUpdate = {};
  var edgesToUpdate = {};

  validPaths.forEach(function(path) {
    path.forEach(function(nodeId, index) {
      nodesToUpdate[nodeId] = {
        id: nodeId,
        color: "red",
        label: allNodes.find(node => node.id == nodeId).label
      };

      if (index < path.length - 1) {
        var fromNode = nodeId;
        var toNode = path[index + 1];
        var edge = allEdges.find(edge => edge.from == fromNode && edge.to == toNode);
        if (edge) {
          edgesToUpdate[edge.id] = {
            id: edge.id,
            color: "red"
          };
        }
      }
    });
  });

  graph.nodes.update(Object.values(nodesToUpdate));
  graph.edges.update(Object.values(edgesToUpdate));
}
'

visNetwork(nodes, edges) %>%
    visOptions(highlightNearest = TRUE, nodesIdSelection = TRUE) %>%
    visPhysics(stabilization = list(iterations = 2000), solver = "barnesHut", minVelocity = 0.75) %>%
    visEvents(selectNode = highlight_js)

As can be seen here, even though an Asian city is selected (Tokyo), no Latin American cities are highlighted.

In the original dataset, it looks like this:

> df[df$Asia == "Tokyo",]
   LatinAmerica NorthAmerica Europe  Asia
13 Buenos Aires      Houston Madrid Tokyo
15    Sao Paulo  Los Angeles  Paris Tokyo
21       Bogota     New York   Rome Tokyo
23 Buenos Aires      Houston Berlin Tokyo

Can someone please show us how to fix this?

Thanks!