I have diagram and want to add variety of colors to the nodes, so I added this code line from grviz that change node color from the value he has node = "[fillcolor = red]Canis" but it didn't change anything in diagram.
The rest code for diagram:
df <- data.frame(col1 = c( "Cat", "Dog", "Bird"),
col2 = c( "Feline", "Canis", "Avis"),
stringsAsFactors=FALSE)
uniquenodes <- unique(c(df$col1, df$col2))
library(DiagrammeR)
nodes <- create_node_df(n=length(uniquenodes), nodes = seq(uniquenodes), type="number", label=uniquenodes, nodes = "[fillcolor = red]Canis")
edges <- create_edge_df(from=match(df$col1, uniquenodes), to=match(df$col2, uniquenodes), rel="related")
g <- create_graph(nodes_df=nodes, edges_df=edges, attr_theme = NULL)
render_graph(g)
Related
I simulated some data and created a graph network in R using visnetwork:
library(igraph)
library(dplyr)
library(visNetwork)
#create file from which to sample from
x5 <- sample(1:100, 1100, replace=T)
#convert to data frame
x5 = as.data.frame(x5)
#create first file (take a random sample from the created file)
a = sample_n(x5, 1000)
#create second file (take a random sample from the created file)
b = sample_n(x5, 1000)
#combine
c = cbind(a,b)
#create dataframe
c = data.frame(c)
#rename column names
colnames(c) <- c("a","b")
#create graph
graph <- graph.data.frame(c, directed=F)
graph <- simplify(graph)
plot(graph)
fc <- fastgreedy.community(graph)
V(graph)$community <- fc$membership
library(visNetwork)
nodes <- data.frame(id = V(graph)$name, title = V(graph)$name, group = V(graph)$community)
nodes <- nodes[order(nodes$id, decreasing = F),]
edges <- get.data.frame(graph, what="edges")[1:2]
#visnet graph
visNetwork(nodes, edges) %>% visIgraphLayout(layout = "layout_with_fr") %>%
visOptions(highlightNearest = TRUE, nodesIdSelection = TRUE)
Right now, the graph only displays node information when you click on it. Suppose if each node had observed properties in the "original file". E.g.
#add some information corresponding to the original data
other_damages_in_dollars <- rnorm(1000,104,9)
location <- c("canada","usa")
location <- sample(location, 1000, replace=TRUE, prob=c(0.3, 0.7))
type_of_house <- c("single","townhome", "rental" )
type_of_house<- sample(type_of_house , 1000, replace=TRUE, prob=c(0.5, 0.3, 0.2))
#heres how the original data would have looked like
original_data = data.frame(a,b, other_damages_in_dollars, location, type_of_house)
Is there a way to add this information when you click on each node?
#visnet graph - is it possible to use the '$' operator to add these properties?
visNetwork(nodes, edges) %>% visIgraphLayout(layout = "layout_with_fr") %>%
%>% visOptions(highlightNearest = TRUE, nodesIdSelection = TRUE)visEvents(selectEdge = "function(properties) { alert(this.body.data.edges._data[properties.edges[0]].original_data$location); }") %>% visOptions(highlightNearest = TRUE, nodesIdSelection = TRUE)visEvents(selectEdge = "function(properties) { alert(this.body.data.edges._data[properties.edges[0]].original_data$type_of_house); }") %>% visOptions(highlightNearest = TRUE, nodesIdSelection = TRUE)visEvents(selectEdge = "function(properties) { alert(this.body.data.edges._data[properties.edges[0]].original_data$other_damage_in_dollars); }")
You don't need an event. This is built into many of the vis.js elements.
So, I'll start with designing the content of my tooltip. Of the 1000 rows you made of location, home types, and costs, I created a subset with the same number of rows as there are nodes. This is what will be shown in my tooltip.
newTitle = paste0("Location: ", toupper(location[1:nrow(nodes)]),
"<br>Home Type: ", type_of_house[1:nrow(nodes)],
"<br>Damage Related Costs: ",
sprintf("$%.2f", other_damages_in_dollars[1:nrow(nodes)]))
#check it; looks okay
Now I'm going to make my tooltips the titles of my nodes.
# replace the node titles:
nodes$title = newTitle
Call the network and click anywhere on the graph once to activate it. Now you just have to hover....(note the blue box, that means it's listening). There are a lot of nodes really close together, so there will be a bit of delayed response when you move from node to node.
You can get rid of the need to click to activate with visOptions(clickToUse = F).
visNetwork(nodes, edges) %>% visIgraphLayout(layout = "layout_with_fr")
FYI
I didn't go through all of the code in the original question; there's a lot! I'm going to include what I ran before creating my graph, so you know what was in and what was not. This code is not changed from your question.
library(igraph)
library(dplyr)
library(visNetwork)
#create file from which to sample from
x5 <- sample(1:100, 1100, replace=T)
#convert to data frame
x5 = as.data.frame(x5)
#create first file (take a random sample from the created file)
a = sample_n(x5, 1000)
#create second file (take a random sample from the created file)
b = sample_n(x5, 1000)
#combine
c = cbind(a,b)
#create dataframe
c = data.frame(c)
#rename column names
colnames(c) <- c("a","b")
#create graph
graph <- graph.data.frame(c, directed=F)
graph <- simplify(graph)
fc <- fastgreedy.community(graph)
V(graph)$community <- fc$membership
nodes <- data.frame(id = V(graph)$name, title = V(graph)$name, group = V(graph)$community)
nodes <- nodes[order(nodes$id, decreasing = F),]
edges <- get.data.frame(graph, what="edges")[1:2]
#add some information corresponding to the original data
other_damages_in_dollars <- rnorm(1000,104,9)
location <- c("canada","usa")
location <- sample(location, 1000, replace=TRUE, prob=c(0.3, 0.7))
type_of_house <- c("single","townhome", "rental" )
type_of_house<- sample(type_of_house , 1000, replace=TRUE, prob=c(0.5, 0.3, 0.2))
#heres how the original data would have looked like
original_data = data.frame(a,b, other_damages_in_dollars, location, type_of_house)
# example data
library(igraph)
links <- cbind.data.frame(from = rep("A", 6),
to = LETTERS[1:6],
weight = rep((1:3), each =2))
nodes <- nodes <- cbind.data.frame(id = LETTERS[1:6],
feature = rep((1:3), each =2))
net <- graph_from_data_frame(d = links, vertices = nodes, directed = T)
V(net)$color <- V(net)$feature
plot(net, vertex.size=30, edge.arrow.size = 0)
This is what I get:
What I want is to cluster the same colored nodes together, something similar as shown in the figure below. How can I do it?
Maybe the option mark.groups in plot could help
plot(net,mark.groups = split(V(net)$name,V(net)$color))
which gives
I have a large dataset but let's put a toy example:
mydata <- data.table(from=c("John", "John", "Jim"),to=c("John", "Jim", "Jack"))
nodesd=unique(c(mydata$from, mydata$to))
nodes <- create_node_df( n=length(nodesd), label=nodesd, type=nodesd)
edges <- create_edge_df(from = mydata$from, to = mydata$to, rel = "leading_to")
graph <- create_graph( nodes_df = nodes, edges_df = edges)
render_graph(graph)
But I get this:
Instead of the expected result:
I got that one using first igraph, but I'd like to avoid that step.
UPDATE:
library(data.table)
mydata <- data.table(from=c("John", "John", "Jim"),to=c("John", "Jim", "Jack"), stringsAsFactors = T)
mydata is already using factors. I don't need extra steps converting factors.
I can create the plot with igraph:
library(igraph)
mygraph <- graph_from_data_frame(d=mydata, directed=T)
plot(mygraph)
Or use its object to build a DiagrammeR plot:
V(mygraph)$label = V(mygraph)$name
V(mygraph)$name = factor(V(mygraph)$name, levels=as.character(V(mygraph)$name))
mygraph2 <- from_igraph(mygraph)
render_graph(mygraph2)
But now I try to do it directly from Diagrammer, without igraph:
nodesd = unique(unlist(mydata[,.(from,to)]))
nodes <- create_node_df( n=length(nodesd), label=nodesd)
edges <- create_edge_df(from = mydata$from, to = mydata$to, rel = "leading_to")
graph <- create_graph( nodes_df = nodes, edges_df = edges)
render_graph(graph)
What's the problem?
With your 1st code I got:
> mydata <- data.table(from=c("John", "John", "Jim"),to=c("John", "Jim", "Jack"))
> nodesd=unique(c(mydata$from, mydata$to))
> nodes <- create_node_df( n=length(nodesd), label=nodesd, type=nodesd)
> edges <- create_edge_df(from = mydata$from, to = mydata$to, rel = "leading_to")
Warning messages:
1: In create_edge_df(from = mydata$from, to = mydata$to, rel = "leading_to") :
NAs introduced by coercion
2: In create_edge_df(from = mydata$from, to = mydata$to, rel = "leading_to") :
NAs introduced by coercion
> graph <- create_graph( nodes_df = nodes, edges_df = edges)
> render_graph(graph)
As #user20650 said, it is an issue with character and factors. So I make a change.
mydata <- data.frame(from=c("John", "John", "Jim"),
to=c("John", "Jim", "Jack"))
mydata$from <- as.character(mydata$from)
mydata$to <- as.character(mydata$to)
nodesd = unique(c(mydata$from, mydata$to))
nodes <- create_node_df( n=length(nodesd), label=nodesd, type=nodesd)
edges <- create_edge_df(from = factor(mydata$from, levels = nodesd),
to = factor(mydata$to, levels = nodesd),
rel = "leading_to")
graph <- create_graph(nodes_df = nodes, edges_df = edges)
render_graph(graph)
I got the result below.
Result:
I hope it can help.
I want to get diagram similar to picture below, but code I use creates different diagram. With rbind I added some hierarchy to a diagram. In data frame col0 there is a string with names of animals. In col1 string is split into individual animals & col2 is adding latin name for a animal. col1 data are always changing and in col2 data constant (there always be feline or canis names in that column).
library(igraph)
# I create my dataframe with animals
df <- data.frame(col0 = c("Cat Dog Wolf", "Cat Dog Wolf", "Cat Dog Wolf"),
col1 = c( "Cat", "Dog", "Wolf"),
col2 = c( "Feline", "Canis", "Canis2"))
# Add extra lines for hierarchy
# These lines work with current graph for a new one these should be replace or deleted
df <-rbind(df, data.frame(col0 = "Cat Dog Wolf", col1 = "Feline", col2 ="Animal"))
df <-rbind(df, data.frame(col0 = "Cat Dog Wolf", col1 = "Canis", col2 = "Animal"))
df <-rbind(df, data.frame(col0 = "Cat Dog Wolf", col1 = "Canis2", col2 = "Canis"))
##########
df <-df[c('col2', 'col1')]
names(df) <-c('from', 'to')
abc <-union(df$to, df$from)
###########
g <-graph.data.frame(df, directed = TRUE, vertices = abc)
plot(g, vertex.size = 20, vertex.label.dist = 0.5, vertex.color = c("blue",
"red", "green", "white", "orange" ),
edge.arrow.size = 0.5, layout = layout.reingold.tilford(g))
This is the graph that the above code outputs, but it's not quite what I want:
I want a similar diagram to what's shown below:
I think that I understand what you want, but I will restate the problem
so that you can confirm whether or not I understood. I think that what
you want to do is this:
Find all of the leaves in the tree, i.e. the nodes with no descendants.
Each leaf will have one parent. Rename the parent with the name of the
leaf, then delete the leaf from the graph. The following code implements that.
## Assume that we have created the graph g using your code
g2 = g # Keep original graph intact
SourceNodes = sapply(strsplit(attr(E(g2), "vnames"), "\\|"), "[", 1)
DestNodes = sapply(strsplit(attr(E(g2), "vnames"), "\\|"), "[", 2)
## Leaf nodes are nodes that are destinations, but not sources
## Also need the node numbers for later deletion
(LeafNodes = DestNodes[which(!(DestNodes%in% SourceNodes ))])
[1] "Cat" "Dog" "Wolf"
(LeafNumbers = match(LeafNodes, attr(V(g), "name")))
[1] 1 2 3
## Find the parents of the leaves
(UpOne = SourceNodes[match(LeafNodes, DestNodes)])
[1] "Feline" "Canis" "Canis2"
## Rename the UpOne nodes (parents of leaves)
vertex_attr(g2)$name[match(UpOne, vertex_attr(g2)$name)] = LeafNodes
## Now delete the leaf nodes and plot
g2 = delete_vertices(g2, LeafNumbers)
plot(g2, vertex.size = 20, vertex.label.dist = 0.5,
vertex.color = c("red", "green", "white", "orange" ),
edge.arrow.size = 0.5, layout = layout.reingold.tilford(g2))
Result
There is dataset with code below. And I need get a graph like in the picture, without changing frame. I tried use rbind to add more hierarchy to data frame in favor to get diagram like in picture. col0 and col1 data is changing debending on data while col2 remains always the same.
df <- data.frame(col0 = c("Cat Dog Wolf", "Cat Dog Wolf", "Cat Dog Wolf"),
col1 = c( "Cat", "Dog", "Wolf"),
col2 = c( "Feline", "Canis", "Canis2"))
df <-rbind(df, data.frame(col0="Cat Dog Wolf", col1 = "Canis2", col2 = "Canis"))
df <-df[c('col1', 'col2')]
names(df) <-c('from', 'to')
abc <-union(df$to, df$from)
g <-graph.data.frame(df, directed = TRUE, vertices = abc)
plot(g, vertex.size = 20, vertex.label.dist = 0.5, vertex.color = "blue",
edge.arrow.size = 0.5, layout = layout.reingold.tilford(g))
You need three edges taken from only two columns ("From" and "To"). But you have three columns in df so you have to choose from them. I created a new column with the names from col1 and col2 pasted together. Then, I chose the first two vertex from the top and rbind the third one.
df <- data.frame(col0 = "Cat Dog Wolf",
col1 = c( "Cat", "Dog", "Wolf"),
col2 = c( "Feline", "Canis", "Canis2"))
df$col1_2 <- paste(df$col2,df$col1)
df <- rbind(df[1:2,c(1,4)],data.frame(col0=df[2,4],col1_2=df[3,4]))
names(df) <-c('from', 'to')
abc <-union(df$to, df$from)
g <-graph.data.frame(df, directed = TRUE, vertices = abc)
plot(g, vertex.size = 20, vertex.label.dist = 0.5, vertex.color = c("lightblue","red","green","white"),
edge.arrow.size = 0.5, layout = layout.reingold.tilford(g))