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:
library(visNetwork)
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!
3
Answers
I update the js function to identify and highlight all possible travel routes that pass through a selected node. The main changes include ensuring that paths are found correctly and that nodes and edges are updated to reflect the correct paths, including a check to ensure that the path includes the selected node. Now, when you click on a node, the routes passing through it should be highlighted properly…please validate
Assuming that you really want to retrieve all paths of a certain length which pass through a city, you can do the following:
N.B. For nicer code decoration I typeset the following Javascript codes as JavaScript. For the usage in R you should define those of course as strings (escaped by
JS
) and pass them to the respective functions,Idea
window.routes
).Codes
store_all_paths
handle_click
handle_deselect
visNetwork
I think visnetwork library is your best option – recreated it with just the following code: