The following code produces a nice network diagram:
library(igraph);library(visNetwork);library(dplyr)
set.seed(123)
nnodes <- 10
nnedges <- 20
nodes <- data.frame(id = 1:nnodes)
edges <- data.frame(from = sample(1:nnodes, nnedges, replace = T),
to = sample(1:nnodes, nnedges, replace = T))
visNetwork(nodes, edges) %>%
visIgraphLayout(layout = "layout_in_circle") %>%
visNodes(shape="circle") %>%
visOptions(highlightNearest = list(enabled = T, hover = T), nodesIdSelection = T)
My question is: How can I disable that edges that leave from a neighboring node are displayed as well (e.g. when node 8 is selected, I don't want the edge from 3 to 9 to be shown).
Edit: Libraries added, thx for poining that out
Using the comment from Djack and wici, I achieved the following solution:
library(igraph);library(visNetwork);library(dplyr)
set.seed(123)
nnodes <- 10
nnedges <- 20
nodes <- data.frame(id = 1:nnodes, label = 1:nnodes)
edges <- data.frame(from = sample(1:nnodes, nnedges, replace = T),
to = sample(1:nnodes, nnedges, replace = T))
visNetwork(nodes, edges) %>%
visIgraphLayout(layout = "layout_in_circle") %>%
visNodes(shape="circle") %>%
visOptions(highlightNearest = list(enabled = T, hover = T, algorithm="hierarchical"),nodesIdSelection = T) %>%
visInteraction(hover = T)
I hope, thats what you're looking for.
Related
so this is my code pretty simple flowchart. I was wondering how I could size the nodes so they're on a fixedsize (fixedsize = FALSE does not work) so they change size based on the text inside the boxes. I also was wondering is their a way to color the nodes based on information that is entered into the table?
any help would be appreciated, thank you
library(DiagrammeR)
library(dplyr)
e <- read.csv("edges.csv",stringsAsFactors = FALSE)
n <- read.csv("nodes.csv", stringsAsFactors = FALSE)
e$to <- as.character(e$to)
create_graph() %>%
add_nodes_from_table(table=n,label_col = task) %>%
add_edges_from_table(table=e,from_col = from,to_col = to,from_to_map = label) %>%
set_node_attrs(
node_attr = "shape",
values = "square"
) %>%
set_node_attrs(
node_attr = "fixedsize",
values = FALSE) %>%
render_graph(layout = "tree")
Output of flow chart
edges
nodes
I have a network diagram with a few nodes, each node having some data, including an ID and its name.
I'm building the visNetwork object like this:
getDiagramPlot <- function(nodes, edges){
v <- visNetwork(
nodes,
edges
) %>%
visPhysics(stabilization = TRUE, enabled = TRUE) %>%
visOptions(highlightNearest = list(enabled = T, degree = 1, hover = F), autoResize = TRUE, collapse = FALSE) %>%
visEdges(color = list(highlight = "red")) %>% # The colour of the edge linking nodes
visLayout(improvedLayout = TRUE) %>%
visEdges(arrows = edges$arrows) %>%
visInteraction(multiselect = F)
return(v)
}
What I'm after is being able to pipe in visEvents and call a function in my code, ideally passing the ID as a parameter. Something like:
testFunction <- function(node_id){
print(paste("The selected node ID is:", node_id))
}
The examples I've seen online are mostly using the javascript alert() in their examples, but I'm looking to break out of javascript and call an R function in my code.
Any help with this would be much appreciated! Thank you in advance.
You can use Shiny.onInputChange in javascript to set anything as a Shiny input variable. This does the trick.
EDIT: Use doubleClick in visEvents to trigger the code on double click. See https://rdrr.io/cran/visNetwork/man/visEvents.html
library(shiny)
library(visNetwork)
ui <- fluidPage(
visNetworkOutput('network')
)
server <- function(input, output, session) {
getDiagramPlot <- function(nodes, edges){
v <- visNetwork(
nodes,
edges
) %>%
visPhysics(stabilization = TRUE, enabled = TRUE) %>%
visOptions(highlightNearest = list(enabled = T, degree = 1, hover = F), autoResize = TRUE, collapse = FALSE) %>%
visEdges(color = list(highlight = "red")) %>% # The colour of the edge linking nodes
visLayout(improvedLayout = TRUE) %>%
visEdges(arrows = edges$arrows) %>%
visInteraction(multiselect = F) %>%
visEvents(doubleClick = "function(nodes) {
Shiny.onInputChange('current_node_id', nodes.nodes);
;}")
return(v)
}
testFunction <- function(node_id){
print(paste("The selected node ID is:", node_id))
}
nodes <- data.frame(id = 1:3, label = 1:3)
edges <- data.frame(from = c(1,2), to = c(1,3))
output$network <- renderVisNetwork(
getDiagramPlot(nodes, edges)
)
observeEvent(input$current_node_id,{
testFunction(input$current_node_id)
})
}
shinyApp(ui, server)
How can I explicitly place nodes on a visNetwork graph?
Or: How can I recreate that graphic in R using visNetwork or an alternative?
Background: The ultimate goal is to represent Causal Loop Diagrams coming from Vensim files. Placing the nodes explicitly is just the first (crucial) step, because in Causal Loop Diagrams the visual mapping of nodes is part of the information (unlike in general graph theory). So if anybody has advice on the bigger picture aka. 'Bringing Causal Loop Diagram Modeling to R', I'll be more than happy.
What I tried:
library("visNetwork")
nodes <- data.frame(id = 1:3, label = c("one", "two", "three"))
edges <- data.frame(from = c(1,1,2), to = c(2,3,1))
visNetwork(nodes, edges, width = "100%", title = nodes$labels, stringsAsFactors = FALSE) %>% visEdges(arrows = "to")
which plots something like (exact layout will change, because of random seed):
With the Q&A from here I tried to place nodes manually by setting x and y values.
library("visNetwork")
nodes <- data.frame(id = 1:3, label = c("one", "two", "three"), x = c(0,1,2), y = c(0,1,2))
edges <- data.frame(from = c(1,1,2), to = c(2,3,1))
visNetwork(nodes, edges, width = "100%", title = nodes$labels, stringsAsFactors = FALSE) %>% visEdges(arrows = "to")
which plots:
..and I really don't understand what's the correspondance between x, y and the placing on the screen..
Also I could not find anything in the docs for visLayout.
It somehow turns out, that the x and y args are not working. Here a solution:
library("visNetwork")
nodes <- data.frame(id = 1:3, label = c("one", "two", "three"))
edges <- data.frame(from = c(1,1,2), to = c(2,3,1))
coords <- as.matrix(data.frame(x = c(0,1,2),
y = c(0,1,2),
stringsAsFactors = FALSE))
visNetwork(nodes, edges, width = "100%", title = nodes$labels) %>%
visNodes() %>%
visOptions(highlightNearest = TRUE) %>%
visInteraction(navigationButtons = TRUE,
dragNodes = TRUE, dragView = TRUE,
zoomView = FALSE) %>%
visEdges(arrows = 'to') %>%
visIgraphLayout(layout = "layout.norm", layoutMatrix = coords)
For history see also here.
Perhaps these links might be helpful for what you want to achive: causaleffect and plot.CLD
Using ggraph instead of visNetwork simplifies things.
library(ggraph)
library(igraph)
g <- make_graph(edges = c(1,2,2,1,1,3))
V(g)$name <- c('one', 'two', 'three')
ggraph(g, layout = 'manual', node.positions = data.frame(x = c(1,1,2), y = c(2,1,2.1))) +
geom_edge_arc(aes(start_cap = label_rect(node1.name),
end_cap = label_rect(node2.name)),
angle_calc = 'along',
label_dodge = unit(2.5, 'mm'),
arrow = arrow(length = unit(4, 'mm'))) +
geom_node_text(aes(label = name, x = x, y = y))
This plots
which is (apart from gridlines and colours) what I was searching for.
I have data in an excel table with two pertinent columns:
Employee Name and Manager Name.
I want to use networkD3 in R to create a Sankey Diagram with this data to show how our organization is split up. I'm a relative amateur with R but I've been able to produce Sankey charts by hard-coding each node. Is it possible to do this with the data I have?
library(networkD3)
nodes = data.frame("name" =
c(All_Employees$`Employee Name`))
links = as.data.frame(matrix(c(
All_Employees$`Employee Name`,All_Employees$`Manager Name`,1),
byrow = TRUE, ncol = 3))
names(links) = c("source", "target", "value")
sankeyNetwork(Links = links, Nodes = nodes,
Source = "source", Target = "target",
Value = "value", NodeID = "name",
fontSize= 12, nodeWidth = 30)
A Sankey diagram is probably not the best type of plot for this, but if you arrange your data into the proper format first, it will work...
All_Employees <-
read.csv(header = T, na.strings = "", stringsAsFactors = F, check.names = F,
text = "
Employee Name,Manager Name
Betty,
Tom,Betty
Bob,Betty
Mark,Tom
John,Tom
Sally,Bob")
node_names <- factor(sort(unique(as.character(unname(unlist(All_Employees))))))
nodes <- data.frame(name = node_names)
links <- data.frame(source = match(All_Employees$`Manager Name`, node_names) - 1,
target = match(All_Employees$`Employee Name`, node_names) - 1,
value = 1)
links <- links[!is.na(links$source), ]
library(networkD3)
sankeyNetwork(Links = links, Nodes = nodes,
Source = "source", Target = "target",
Value = "value", NodeID = "name",
fontSize = 12, nodeWidth = 30)
Alternatively, you could use diagonalNetwork() which creates a tree diagram that is probably better suited...
library(dplyr)
library(data.tree)
library(networkD3)
All_Employees %>%
filter(!is.na(`Manager Name`)) %>%
data.tree::FromDataFrameNetwork() %>%
data.tree::ToListExplicit(unname = TRUE) %>%
diagonalNetwork()
Or if you're using the dev version of networkD3, you can more easily use the new treeNetwork() function, which is has more customization (but is still buggy because it's still in dev)...
library(dplyr)
library(networkD3)
All_Employees %>%
rename(nodeId = `Employee Name`, parentId = `Manager Name`) %>%
mutate(name = nodeId) %>%
treeNetwork(direction = "down", linkType = "elbow")
I am creating graph structure
id <- c(1,2,3,4,5,6,7,8,9)
label <- c("All", "Cat", "Dog", "Rice","Fish", "Bread","Rice","Fish", "Bread")
nodes <- data.frame(id, label)
edges <- data.frame(
from = c(1,1,2,2,2,3,3,3),
to = c(2,3,4,5,6,7,8,9)
)
visNetwork(nodes, edges, width = "100%",height = "800px") %>% visNodes(shape = "square") %>%
visEdges(arrows = "to") %>%
visInteraction(navigationButtons = TRUE)%>%
visHierarchicalLayout(levelSeparation = 200) %>%
visOptions(manipulation = TRUE)
expecting it to show up like this.
However the actual output is like this
The node positions are incorrect , I cannot manually move the nodes and this makes it very hard to explain. Need help rearranging the nodes based on the expected output above.
You can specify the level for each node to get the orientation you want.
library(visNetwork)
id <- c(1,2,3,4,5,6,7,8,9)
label <- c("All", "Cat", "Dog", "Rice","Fish", "Bread","Rice","Fish", "Bread")
nodes <- data.frame(id, label, level = c( 1,2,2,3,3,3,3,3,3))
edges <- data.frame(
from = c(1,1,2,2,2,3,3,3),
to = c(2,3,4,5,6,7,8,9)
)
visNetwork(nodes, edges, width = "100%",height = "800px") %>% visNodes(shape = "square") %>%
visEdges(arrows = "to") %>%
visInteraction(navigationButtons = TRUE)%>%
visHierarchicalLayout(levelSeparation = 200) %>%
visOptions(manipulation = TRUE)