How to make a star plot with igraph? - r

I am working with igraph for the first time and would like to do a "star plot"(make_star()) with the package igraph.
For this I have prepared a sample data set, it has two columns: name and wght.
I want "ME" to be in the center of the plot and all arrows should go out of it. It would be great if the arrow width corresponded to the values ​​from wght (maybe with edge.width) OR the weights on the arrows.
My code looks like this:
library(igraph)
wght <- runif(6, min = 1, max = 10)
name <- c("John", "Jim", "Jack", "Jesse", "Justin", "Peter")
data <- data.frame(name, wght)
st <- make_star(n = 6, mode = "out")
plot(st, vertex.label = data$name)
Output:
what I want:

Create a graph where "Me" is included as a vertex. Add edge attribute "weight". Create star layout with "Me" as center. Set edge widths according to weights. Plot!
g <- graph_from_data_frame(data.frame(from = "Me", to = name))
E(g)$weights <- wght
plot(g, layout = layout_as_star(g, center = V(g)["Me"]), edge.width = E(g)$weights)
Data
set.seed(1)
wght <- runif(6, min = 1, max = 10)
name <- c("John", "Jim", "Jack", "Jesse", "Justin", "Peter")

Fun to learn about a new package. This should do it for you:
st <- make_star(n=6,mode = "out") %>%
set_vertex_attr("label", index = 1, value = "ME") %>%
set_vertex_attr("label", index = 2:6, value = name[2:6])
plot(st)

Related

Isolating a "branch" in a sankey diagram using networkd3

I am using sankeyNetwork() from the networkD3 package for visualizing some data. I was wondering if theres a way to "isolate" a branch from start to finish, ignoring the irrelevant links.
Example: I've got this: SankeyGot
And I want to extract this: SankeyWant
reproducible example:
set.seed(9)
df <- tibble(
source = sample(stringr::words, 5) %>% rep(2),
target = c(sample(words, 7), source[1:3]),
values = rnorm(10, 10, 7) %>% round(0) %>% abs)
nodes <- data.frame(names = unique(c(df$source, df$target)))
links <- tibble(
source = match(
df$source, nodes$names) -1,
target = match(
df$target, nodes$names) -1,
value = df$values
)
sankeyNetwork(Links = links, Nodes = nodes, Source = "source",
Target = "target", Value = "value", NodeID = "names",
iterations = 64, sinksRight = F, fontSize = 14)
I'd like to be able to filter out "name" for example and get everything that connects to that on all levels upstream and downstream - how would i go about doing this?
Calculating the paths from a node in a graph is non-trivial, but the igraph package can help with the all_simple_paths(). However, heed that warning in the help file...
Note that potentially there are exponentially many paths between two
vertices of a graph, and you may run out of memory when using this
function, if your graph is lattice-like.
(I don't know what your words vector is, so I recreated the links data.frame manually)
library(dplyr)
library(networkD3)
set.seed(9)
df <- read.csv(header = TRUE, text = "
source,target
summer,obvious
summer,structure
however,either
however,match
obvious,about
obvious,non
either,contract
either,produce
contract,paint
contract,name
")
df$values <- rnorm(10, 10, 7) %>% round(0) %>% abs()
# use graph to calculate the paths from a node
library(igraph)
graph <- graph_from_data_frame(df)
start_node <- "name"
# get nodes along a uni-directional path going IN to the start_node
connected_nodes_in <-
all_simple_paths(graph, from = start_node, mode = "in") %>%
unlist() %>%
names() %>%
unique()
# get nodes along a uni-directional path going OUT of the start_node
connected_nodes_out <-
all_simple_paths(graph, from = start_node, mode = "out") %>%
unlist() %>%
names() %>%
unique()
# combine them
connected_nodes <- unique(c(connected_nodes_in, connected_nodes_out))
# filter your data frame so it only includes links/edges that start and
# end at connected nodes
df <- df %>% filter(source %in% connected_nodes & target %in% connected_nodes)
nodes <- data.frame(names = unique(c(df$source, df$target)))
links <- tibble(
source = match(
df$source, nodes$names) -1,
target = match(
df$target, nodes$names) -1,
value = df$values
)
sankeyNetwork(Links = links, Nodes = nodes, Source = "source",
Target = "target", Value = "value", NodeID = "names",
iterations = 64, sinksRight = F, fontSize = 14)
If you code sankeyNetwork as an object you can use str(object) to identify it as a list, with a matrix called x that holds your input df
list_sankey <- sankeyNetwork(Links = links, Nodes = nodes, Source = "source", Target = "target", Value = "value", NodeID = "names", iterations = 64, sinksRight = F, fontSize = 14)
str(list_sankey)
You can then filter the x matrix to only contrain your desired input source and output target nodes
list_sankey_filter <- list_sankey
list_sankey_filter$x$links <- list_sankey_filter$x$links %>% filter(source %in% c(4, 2, 0), target %in% c(4, 2, 0, 10))
This then gives you the object below.

Interactively identify 3D object in rgl plot

I want to identify 3d cylinders in an rgl plot to obtain one attribute of the nearest / selected cylinder. I tried using labels to simply spell out the attribute, but I work on data with more than 10.000 cylinders. Therefore, it gets so crowded that the labels are unreadable and it takes ages to render.
I tried to understand the documentation of rgl and I guess the solution to my issue is selecting the cylinder in the plot manually. I believe the function selectpoints3d() is probably the way to go. I believe it returns all vertices within the drawn rectangle, but I don't know how to go back to the cylinder data? I could calculate which cylinder is closest to the mean of the selected vertices, but this seems like a "quick & dirty" way to do the job.
Is there a better way to go? I noticed the argument value=FALSE to get the indices only, but I don't know how to go back to the cylinders.
Here is some dummy data and my code:
# dummy data
cylinder <- data.frame(
start_X = rep(1:3, 2)*2,
start_Y = rep(1:2, each = 3)*2,
start_Z = 0,
end_X = rep(1:3, 2)*2 + round(runif(6, -1, 1), 2),
end_Y = rep(1:2, each = 3)*2 + round(runif(6, -1, 1), 2),
end_Z = 0.5,
radius = 0.25,
attribute = sample(letters[1:6], 6)
)
# calculate centers
cylinder$center_X <- rowMeans(cylinder[,c("start_X", "end_X")])
cylinder$center_Y <- rowMeans(cylinder[,c("start_Y", "end_Y")])
cylinder$center_Z <- rowMeans(cylinder[,c("start_Z", "end_Z")])
# create cylinders
cylinder_list <- list()
for (i in 1:nrow(cylinder)) {
cylinder_list[[i]] <- cylinder3d(
center = cbind(
c(cylinder$start_X[i], cylinder$end_X[i]),
c(cylinder$start_Y[i], cylinder$end_Y[i]),
c(cylinder$start_Z[i], cylinder$end_Z[i])),
radius = cylinder$radius[i],
closed = -2)
}
# plot cylinders
open3d()
par3d()
shade3d(shapelist3d(cylinder_list, plot = FALSE), col = "blue")
text3d(cylinder$center_X+0.5, cylinder$center_Y+0.5, cylinder$center_Z+0.5, cylinder$attribute, color="red")
# get attribute
nearby <- selectpoints3d(value=TRUE, button = "right")
nearby <- colMeans(nearby)
cylinder$dist <- sqrt(
(nearby["x"]-cylinder$center_X)**2 +
(nearby["y"]-cylinder$center_Y)**2 +
(nearby["z"]-cylinder$center_Z)**2)
cylinder$attribute[which.min(cylinder$dist)]
If you call selectpoints3d(value = FALSE), you get two columns. The first column is the id of the object that was found. Your cylinders get two ids each. One way to mark the cylinders is to use "tags". For example, this modification of your code:
# dummy data
cylinder <- data.frame(
start_X = rep(1:3, 2)*2,
start_Y = rep(1:2, each = 3)*2,
start_Z = 0,
end_X = rep(1:3, 2)*2 + round(runif(6, -1, 1), 2),
end_Y = rep(1:2, each = 3)*2 + round(runif(6, -1, 1), 2),
end_Z = 0.5,
radius = 0.25,
attribute = sample(letters[1:6], 6)
)
# calculate centers
cylinder$center_X <- rowMeans(cylinder[,c("start_X", "end_X")])
cylinder$center_Y <- rowMeans(cylinder[,c("start_Y", "end_Y")])
cylinder$center_Z <- rowMeans(cylinder[,c("start_Z", "end_Z")])
# create cylinders
cylinder_list <- list()
for (i in 1:nrow(cylinder)) {
cylinder_list[[i]] <- cylinder3d(
center = cbind(
c(cylinder$start_X[i], cylinder$end_X[i]),
c(cylinder$start_Y[i], cylinder$end_Y[i]),
c(cylinder$start_Z[i], cylinder$end_Z[i])),
radius = cylinder$radius[i],
closed = -2)
# Add tag here:
cylinder_list[[i]]$material$tag <- cylinder$attribute[i]
}
# plot cylinders
open3d()
par3d()
shade3d(shapelist3d(cylinder_list, plot = FALSE), col = "blue")
text3d(cylinder$center_X+0.5, cylinder$center_Y+0.5, cylinder$center_Z+0.5, cylinder$attribute, color="red")
# Don't get values, get the ids
nearby <- selectpoints3d(value=FALSE, button = "right", closest = FALSE)
ids <- nearby[, "id"]
# Convert them to tags. If you select one of the labels, you'll get
# a blank in the list of tags, because we didn't tag the text.
unique(tagged3d(id = ids))
When I was trying this, I found that using closest = TRUE in selectpoints3d seemed to get too many ids; there may be a bug there.

Change edge thickness according to a column of a dataframe containing relations between actors

This code plots a graph from dataframes of actors and relations.
library(igraph)
actors <- data.frame(name=c("Alice", "Bob", "Cecil", "David",
"Esmeralda"))
relations <- data.frame(from=c("Bob", "Cecil", "Cecil", "David",
"David", "Esmeralda"),
to=c("Alice", "Bob", "Alice", "Alice", "Bob", "Alice"),
friendship=c(4,15,5,2,11,1))
g <- graph_from_data_frame(relations, directed=TRUE, vertices=actors)
plot(g)
The result is:
I would like to change the thickness (not the length) of the arcs based on the value of relations$friendship.
Try
plot(g,edge.width = E(g)$friendship, edge.arrow.size = E(g)$friendship)
Note that, the first value of E(g)$friendship is assigned to edge.arrow.size, instead of a vector. Maybe the improved feature will be added to future igraph version.
arrow.size The size of the arrows. Currently this is a constant, so it
is the same for every edge. If a vector is submitted then only the
first element is used, ie. if this is taken from an edge attribute
then only the attribute of the first edge is used for all arrows. This
will likely change in the future.
The default value is 1.
arrow.width The width of the arrows. Currently this is a constant, so
it is the same for every edge. If a vector is submitted then only the
first element is used, ie. if this is taken from an edge attribute
then only the attribute of the first edge is used for all arrows. This
will likely change in the future.
This argument is currently only used by plot.igraph.
The default value is 1, which gives the same width as before this
option appeared in igraph.
This can be achieved very simply.
First your code:
library(igraph)
actors <- data.frame(name=c("Alice", "Bob", "Cecil", "David",
"Esmeralda"))
relations <- data.frame(from=c("Bob", "Cecil", "Cecil", "David",
"David", "Esmeralda"),
to=c("Alice", "Bob", "Alice", "Alice", "Bob", "Alice"),
friendship=c(4,15,5,2,11,1))
g <- graph_from_data_frame(relations, directed=TRUE, vertices=actors)
Now let's create a graph with a thickness of 2, line color black and line type 2.
plot(g, edge.width = 2, edge.color = "black", edge.lty = 2)
Of course, you can change it as you like
plot(g, edge.width = 5, edge.color = "black", edge.lty = 1)
Hope that's what you meant.
Small update
Finally, you may want to find the coordinates of the elements. You can do it this way:
coords = layout_nicely(g)
coords[5,]=c(20, 20)
coords
output
[,1] [,2]
[1,] 15.21285 18.97650
[2,] 15.18511 20.08411
[3,] 14.21575 19.70269
[4,] 16.17453 19.75255
[5,] 20.00000 20.00000
Plot
plot(g, layout=coords, edge.width = 5, edge.color = "black", edge.lty = 1)
You can also set other cutout attributes
plot(g, vertex.size = 20, vertex.color = "red", vertex.shape = "square",
edge.width = 3, edge.color = "black", edge.lty = 3,
edge.label = relations$friendship, edge.curved = TRUE)
Also note that any of these parameters can also come from a vector.
So there is no obstacle for the thickness to come from the variable friendship, for example.
plot(g, vertex.size = 20, vertex.color = "red",
vertex.shape = c("square","circle","square","circle","rectangle"),
edge.width = relations$friendship, edge.color = "black", edge.lty = c(1,2,3,1,2,3),
edge.label = 10:20, edge.curved = TRUE)

Convert ggraph to interative plot with plotyly or Network3D

I was looking for an example or tutorial to convert a ggraph object to an iterative force network.
First I tried to convert to plotly object using plotly::ggplotly function. But seems the plotly don't deal nicely with this kind of conversion and miss the edges.
But I find the network3D, I can convert an igraph object to a network3D object, but it is not what I wanted. And this package has too verbose functions. Anyway, there is no function to convert from ggraph object.
So, my question is really basic but... Do you know any method to crate an interactive ggraph network?
Thanks
Try the ggiraph package, it works with ggraph as you can see in the example here (bottom of the page).
For future reference (if the above link may die), here's the example of ggiraph (not my code):
library(ggraph)
library(igraph)
library(ggiraph)
actors <- data.frame(
name = c("Alice", "Bob", "Cecil", "David", "Esmeralda"),
age = c(48,33,45,34,21),
gender = c("F","M","F","M","F")
)
relations <- data.frame(
from = c("Bob", "Cecil", "Cecil", "David", "David", "Esmeralda"),
to = c("Alice", "Bob", "Alice", "Alice", "Bob", "Alice"),
same.dept = c(FALSE,FALSE,TRUE,FALSE,FALSE,TRUE),
friendship = c(4,5,5,2,1,1),
advice = c(4,5,5,4,2,3)
)
g <- graph_from_data_frame(relations,
directed = TRUE, vertices = actors)
z <- ggraph(g, layout = 'linear', circular = TRUE) +
geom_edge_arc(color = "red", edge_width = .2) +
geom_point_interactive(size = 5,
mapping = aes(x = x, y = y, data_id = gender,
tooltip = paste0(name, ": ", age, "y.o."))
) + theme_graph()
girafe(ggobj = z, width_svg = 5, height_svg = 5,
options = list(opts_sizing(rescale = FALSE)))
It seems plotly does not support ggraph yet, but you can track the progress here.

Trouble creating lists in R for the networkD3 package

I'd like to create the radial network above utilizing the R package networkD3. I read the guide here which utilizes lists to create radial networks. Unfortunately my R skills with lists are lacking. They're actually non-existent. Fortunately there's the R4DS guide here.
After reading everything I come up with this code below, to create the diagram above.
library(networkD3)
nd3 <- list(Start = list(A = list(1, 2, 3), B = "B"))
diagonalNetwork(List = nd3, fontSize = 10, opacity = 0.9)
Alas, my attempt fails. And subsequent attempts fail to generate anything that's close to the diagram above. I'm pretty sure it's my list that's wrong. Maybe you can show me the right list and things will start to make sense.
Jason!
The issue here is that the parameter nd3 has a very specific grammar of node name and children. So your code should look like this:
library(networkD3)
nd3 <- list(name = "Start", children = list(list(name = "A",
children = list(list(name = "1"),
list(name = "2"),
list(name = "3")
)),
list(name = "B")))
diagonalNetwork(List = nd3, fontSize = 10, opacity = 0.9)
If you're like me and the data frame/spreadsheet format is easier to wrap your head around, you could build an easy data frame with your data and then use data.tree functions to convert it to the list/json format...
library(data.tree)
library(networkD3)
source <- c("Start", "Start", "A", "A", "A")
target <- c("A", "B", "1", "2", "3")
df <- data.frame(source, target)
nd3 <- ToListExplicit(FromDataFrameNetwork(df), unname = T)
diagonalNetwork(List = nd3, fontSize = 10, opacity = 0.9)

Resources