I'm using igraph in R, trying to extract a subgraph that comprises only the largest cliques in a graph. I want to plot the graph and the subgraph (1) without moving the vertices and (2) while maintaining numbering. I can't seem to make it work. I tried storing the layout coordinates directly in the vertices but plot seems to rescale things. Setting rescale=FALSE didn't work either. Here's what I have, first plotting the random graph, then highlighting the largest cliques, and finally displaying only the largest cliques:
# plot random graph
g <- sample_gnp(n=30, p=.1)
l=layout_with_fr(g)
V(g)$x <- l[,1]
V(g)$y <- l[,2]
V(g)$id <- 1:vcount(g)
plot(g,vertex.size=6,vertex.label.dist=1,vertex.label=V(g)$id,main="a random network",sub="where are the cliques?")
# highlight largest cliques
lc=unlist(largest_cliques(g))
vcol <- rep("grey80", vcount(g))
vcol[unlist(lc)] <- "gold"
plot(g, vertex.size=6,vertex.color=vcol,vertex.label.dist=1,vertex.label=V(g)$id,main="here they are!",
layout=l)
# plot only the largest cliques, without changing position or vertex numbers
sg = induced_subgraph(g,lc)
sl = cbind(V(sg)$x,V(sg)$y)
plot(sg,vertex.size=6,vertex.label.dist=1,vertex.label=V(sg)$id,vertex.color="gold",
layout=sl)
First of all, you did not set the random seed, so each time you run this code you will get a different graph and layout. I am setting the seed for reproducibility.
# plot random graph
set.seed(2021)
g <- sample_gnp(n=30, p=.1)
l=layout_with_fr(g)
V(g)$x <- l[,1]
V(g)$y <- l[,2]
V(g)$id <- 1:vcount(g)
# highlight largest cliques
lc=unlist(largest_cliques(g))
vcol <- rep("grey80", vcount(g))
vcol[unlist(lc)] <- "gold"
There are other ways to do this, but I will do it using rescale=F.
When you do that, you have to adjust xlim and ylim to the ranges of the layout. Also, it changes the scale, so you need to change the vertex size.
Putting all of that together, I get:
Rx =range(l[,1])
Ry =range(l[,2])
par(mfrow=c(1,2))
plot(g, vertex.size=45,vertex.color=vcol,vertex.label.dist=1,
vertex.label=V(g)$id,main="here they are!", layout=l,
rescale=F, xlim=Rx, ylim=Ry)
# plot only the largest cliques, without changing position or vertex numbers
sg = induced_subgraph(g,lc)
sl = cbind(V(sg)$x,V(sg)$y)
plot(sg,vertex.size=45, vertex.label.dist=1,vertex.label=V(sg)$id,vertex.color="gold",
layout=sl, rescale=F, xlim=Rx, ylim=Ry, main="Unmoved")
you can use set-vertex_attr to set the name attribute for graph g, and then subset the layout lc like below
# plot random graph
set.seed(2021)
g <- sample_gnp(n = 30, p = .1)
l <- layout_with_fr(g)
# highlight largest cliques
lc <- unlist(largest_cliques(g))
g %>%
set_vertex_attr(name = "name", value = seq(vcount(.))) %>%
induced.subgraph(lc) %>%
plot(layout = l[as.integer(names(V(.))), ], vertex.color = "gold")
and you will get
Related
I am using the library igraph in R. I have created an MST graph by using the function mst based on some distance function stored in a dataframe called tree:
gf <- graph_from_data_frame(tree, directed = FALSE)
mstgf <- mst(gf, weights = tree$distance)
I have calculated the eigenvector centrality of each node in the MST as:
ec <- eigen_centrality(mstgf, directed=T, weights=NA)$vector
I have then joined the vector of eigenvector centralities to the data.frame tree:
x <- cbind(names(ec), as.numeric(ec)) %>% as_tibble() %>% mutate(V2 = as.numeric(V2)) %>%
rename(from = V1)
tree <- tree %>% inner_join(.,x, by = "from")
What I want to do is to plot the MST by coloring the nodes in a way to resemble their eigenvector centrality. I am using the following for plotting, yet I don't know how to change the argument vertex.color to obtain something like the image below?
plot.igraph(mstgf,
vertex.color = round(tree$V2,0),
edge.color = "blue",
edge.curved = TRUE,
edge.witdh = 1,
)
Once you've calculated the centralities of your choice, you would like to 1) scale the values to a meaningful categorical range (like 1,2,3,4,5) and 2) associate your centrality categories with colors from a gradient. You don't necessarily have to keep joining and calculating outside igraph.
This is a random network
# Random network
g <- erdos.renyi.game(100,250,'gnm', directed=F)
1) make categories
This forces every eigenvector centrality to assume an integer value between 1 and 10
# Calculate eigen centrality and check the distribution We're attaching the
# result of eigen_centrality() straight onto the vertices as verticy-attributes
V(g)$ec <- eigen_centrality(g, directed=T, weights=NA)$vector
hist(V(g)$ec)
# You could use the scales package, or define this normalisation function:
normalize <- function(x){(x-min(x))/(max(x)-min(x))}
(V(g)$ec_index <- round(normalize(V(g)$ec) * 9) + 1)
#ec_index should now be a category between 1 and 10 for your centralities
You can use any resolution you like.
2) Attach colours from the indexation
There are several packages and ways to load colour-ranges in R (colorspace, colorRamps, RColorBrewer etc).
# Build a color-mapping with 10 categories and set the color of each
# node to the corresponding color of each centrality-measure category
V(g)$color <- colorRampPalette(c("turquoise", "yellow","red"))(10)[V(g)$ec_index]
# Look at what we did
table(V(g)$color)
plot(g, vertex.label=NA, vertex.size=5)
This example should produce something along the lines of this graph here:
The following code generates a Netwrok Graph and can separate the data into two groups, but I would like to apply k-means on it and see how the algorithm clusters the data into the same set of clusters.
library(igraphdata) # library for the graph data
data(karate)
V(karate) %>% print() # shows the list of the nodes
# Reproducible layout
set.seed(69)
l <- layout_with_kk(karate) #sets the layout.
# Plot undecorated Graph Network First.
igraph_options(vertex.size=10)
par(mfrow=c(1,1)) # sets plotting parameters
plot(karate, layout=l, vertex.label=V(karate),
vertex.color=NA) # Plots a basic Graph
# Now decorate, starting with labels.
V(karate)$label <- sub("Actor ", "", V(karate)$name)
V(karate)
# Two Club Leaders get shapes different from other club members.
V(karate)$shape <- "circle"
V(karate)[c("Hi", "John")]$shape <- "rectangle" # sets different shapes for these two only
# Differentiate two factions by color. (Similar to clustering & color-coded)
V(karate)[Faction == 1]$color <- "red"
V(karate)[Faction == 2]$color <- "dodgerblue"
# Vertex area proportional to vertex strength
# (i.e., total weight of incident edges).
V(karate)$size <- 4*sqrt(strength(karate))
V(karate)$size2 <- V(karate)$size * .5
# Weight edges by number of common activities
E(karate)$width <- E(karate)$weight
# Color edges by within/between faction.
F1 <- V(karate)[Faction==1] # sets variable for first cluster (faction)
F2 <- V(karate)[Faction==2] # similar to the above.
E(karate)[ F1 %--% F1 ]$color <- "pink"
E(karate)[ F2 %--% F2 ]$color <- "lightblue"
E(karate)[ F1 %--% F2 ]$color <- "green"
# Offset vertex labels for smaller points (size based, default is zero).
V(karate)$label.dist <-
ifelse(V(karate)$size >= 9.0, 0, 1.0)
# Plot decorated graph, using same layout.
plot(karate, layout=l)
Final Output:
you can get the adjacency matrix of the resultant graph and apply k-means clustering on top of the matrix. It is equivalent to applying k-means to the graph.
Following is the sample code
adj.matrix = get.adjacency(graph, sparse=FALSE)
k <- 3 # no of desired clusters
km <- kmeans(matrix , centers = k, nstart = 25)
I am trying to plot a network that changes in time. The network starts with a certain number of nodes and edges and each time step some of the nodes and edges are removed.
I want to be able to plot the network so that the nodes are in the same place in each. However when I try this. sometimes the nodes shift position in the plot frame even if the relation to each other is the same.
I am making the network change into a gif so even small changes are annoying. I think the change may occur when a large fraction of the nodes are removed but I am not sure.
The code below illustrates this using an ER graph.
library(igraph); library(dplyr)
#generate random graph
set.seed(500)
RandomGraph <- sample_gnm(1000, 2500)
#name nodes
V(RandomGraph)$name <- paste0("Node", 1:1000)
#Get the coordinates of the Nodes
Coords <- layout_with_fr(RandomGraph) %>%
as_tibble %>%
bind_cols(data_frame(names = names(V(RandomGraph))))
#Delete random vertices
deletevertex <-sample( V(RandomGraph)$name, 400)
RandomGraph2 <-delete.vertices(RandomGraph, deletevertex)
#get the coordinates of the remaining Nodes
NetCoords <- data_frame(names = names(V(RandomGraph2))) %>%
left_join(Coords, by= "names")
#plot both graphs
RandomGraph%>%
plot(.,vertex.size=.8, edge.arrow.size=.4, vertex.label = NA, layout = as.matrix(Coords[,1:2]))
RandomGraph2%>%
plot(.,vertex.size=.8, edge.arrow.size=.4, vertex.label = NA, layout = as.matrix(NetCoords[,2:3]))
#They nodes have the same relationship to each other but are not laid out in the same position in the frame
As you can see the plots have placed nodes in the same place relative to each other but not relative to the frame.
How can I have the plot position fixed.
plot.igraph rescales each axis by default (from -1 to +1 on both x and y).
You just need to turn that off: rescale = F and then explicitly set appropriate xlim and ylim values.
For your example code..
RandomGraph%>%
plot(.,vertex.size=.8, edge.arrow.size=.4, vertex.label = NA, layout = as.matrix(Coords[,1:2]),rescale=F,xlim=c(-25,30),ylim=c(-20,35))
RandomGraph2%>%
plot(.,vertex.size=.8, edge.arrow.size=.4, vertex.label = NA, layout = as.matrix(NetCoords[,2:3]),rescale=F,xlim=c(-25,30),ylim=c(-20,35))
The problem is that
identical(range(Coords[1]), range(NetCoords[2]))
# [1] FALSE
Since igraph normalizes the coordinates on a range between -1 and 1 before plotting, this leads to slightly different coordinates for NetCoords compared to Coords. I'd just calculate the normalized coordinates for all nodes beforehand:
coords_rescaled <- sapply(Coords[-3], function(x) -1+((x-min(x))*2)/diff(range(x)))
rownames(coords_rescaled) <- Coords$names
And then assign the normalized coordinates (or the required subset) and set rescale=FALSE (as #jul) already suggested:
par(mfrow=c(1,2), mar=c(1,.5,1,.5))
RandomGraph%>%
plot(.,edge.arrow.size=.4, layout = coords_rescaled, rescale=F);box()
RandomGraph2%>%
plot(.,edge.arrow.size=.4, layout = coords_rescaled[NetCoords$names, ], rescale=F);box()
I have an unconnected graph that I plot with fruchterman-reingold layout in igraph
require(igraph)
er_graph <- erdos.renyi.game(100, 5/20)+erdos.renyi.game(100, 5/20)
coords<-layout.fruchterman.reingold(er_graph)
plot(er_graph,layout=coords, vertex.label=NA)
Plot Example :
The result was two distant clusters.
I wish to decrease the white area in my plot.
Is there a way to scale the coordinate in order to decrease the space between the clusters?
There may be an easy way to do this in one of the layout functions, but you can also directly change the node coordinates after creating the layout. If you look at coords, you can see it's just a matrix of node coordinates. You can use the cluster labels to move the two node clusters closer together programmatically:
require(igraph)
require(dplyr)
er_graph <- erdos.renyi.game(100, 5/20)+erdos.renyi.game(100, 5/20)
# Make layout reproducible
set.seed(40)
coords <- layout.fruchterman.reingold(er_graph)
# Original graph
plot(er_graph,layout=coords, vertex.label=NA)
Move clusters closer together: First, we add the cluster labels to the coordinates and set a parameter f for what fraction of the distance between clusters we want eliminate. Then we subtract from each node f times the difference between the mean coordinates for that cluster and the mean coordinates over both clusters.
# Add cluster labels to coords
coords = data.frame(coords, clust=clusters(er_graph)$membership)
# Move closer by a fraction "f" of mean distance between clusters
f = 0.6
# Shift each node closer to the overall center of mass of the node
coords = coords %>%
mutate(X1 = ifelse(clust==1, X1 - f*(mean(X1[clust==1]) - mean(X1)), X1 - f*(mean(X1[clust==2]) - mean(X1))),
X2 = ifelse(clust==1, X2 - f*(mean(X2[clust==1]) - mean(X2)), X2 - f*(mean(X2[clust==2]) - mean(X2))))
# Convert coords back to original matrix form
coords = as.matrix(coords[,1:2])
# Re-plot graph
plot(er_graph,layout=coords, vertex.label=NA)
I need to plot directed acyclic lattice graph of size m x n, similar as in this picture, but without edges on the contour and without vertexes on the corners:
Is this possible to do with graph.lattice function? If yes, how to set such vertexes' labels (i.e. (x,y) format, not just an integer number) and remove mentioned edges and vertexes? Moreover, is it possible to plot graph in such position (as in a picture) without using tkplot function and rotating it then?
I am not exactly sure what you mean by 'without edges on the contour', but here are some points:
Read ?igraph.plotting for the complete list of plotting parameters.
If you don't want the frame on the vertices, set vertex.frame.color to the same value as vertex.color.
Use layout.grid, see ?layout.grid.
Use vertex.label to set the labels.
If you want to omit some edges, then delete them, or set their width to zero or their color to background color.
If you want to omit some vertices, then attach the coordinates calculated by layout.grid as vertex attributes, and then remove the vertices from the graph.
Something like this could work:
g <- graph.lattice( c(5,5) )
lay <- layout.grid(g)
V(g)$x <- lay[,1]
V(g)$y <- lay[,2]
V(g)$color <- V(g)$frame.color <- "darkolivegreen"
V(g)$label.color <- "lightgrey"
V(g)$label <- paste(V(g)$x+1, V(g)$y+1, sep=",")
To remove the edges, you can select them based on the coordinates of the vertices:
torem <- c(E(g)[ V(g)[x==0] %--% V(g)[x==0] ],
E(g)[ V(g)[y==0] %--% V(g)[y==0] ],
E(g)[ V(g)[x==4] %--% V(g)[x==4] ],
E(g)[ V(g)[y==4] %--% V(g)[y==4] ])
g2 <- delete.edges(g, torem)
And then remove the vertices and plot:
g3 <- delete.vertices(g2, V(g2)[ x %in% c(0,4) & y %in% c(0,4) ])
plot(g3, layout=cbind(V(g3)$x, V(g3)$y))