I have a random graph g and need to split this graph into two separated graphs g1 and g2 with a rule. The split rule is binary matrix E: if (E[i,j]=1) then move the corresponding node to the graph g1, else move the corresponding node to the graph g2. After separation I need to plot three graphs on the screen. I have use the 1s from matrix E in order to define position of nodes from graph g1 on the plot (i.e. mylayout1). My code is shown below.
library(igraph)
set.seed(42)
n <- m <- 5
B <- matrix(sample(0:255, (n*m)^2, replace=T), nrow = n*n, ncol = m*m)
g <- graph.adjacency(B, weighted=TRUE, mode="undirected", diag=FALSE)
V(g)$name <- as.character(1:(n*m))
E <- matrix(sample(0:1, n*m, replace=T), nrow = m, ncol = n)
# split into two graphs, if (E[i,j]=1) then the node move to g1, else to g2
vsubgraph <- c(1:length(E))*E
vsubgraph <- vsubgraph[vsubgraph != 0]
g1 <- induced_subgraph(g, vsubgraph)
g2 <- induced_subgraph(g, setdiff(V(g), vsubgraph))
V(g)[vsubgraph]$color <- "green"
V(g)[setdiff(V(g), vsubgraph)]$color <- "yellow"
V(g1)$name <- vsubgraph
V(g2)$name <- setdiff(V(g), vsubgraph)
V(g1)$color <- "green"
V(g2)$color <- "yellow"
par(mfrow=c(1,3))
# create layout
cx <-rep(1:n, each = m)
cy <-rep(c(1:m), times = n)
mylayout <- as.matrix(cbind(cx, -cy))
plot(g, layout=mylayout,
vertex.shape = "square",
vertex.label = V(g)$name,
edge.label.cex=.75,
xlab='Original graph'
)
cx <- cx * E
cy <- cy * E
cx <- cx[cx != 0]
cy <- cy[cy != 0]
mylayout1 <- as.matrix(cbind(cx, -cy))
plot(g1, layout=mylayout1,
vertex.shape = "square",
vertex.label = V(g)$name,
edge.label.cex=.75,
xlab='1st graph'
)
plot(g2, #layout=mylayout2,
vertex.shape = "square",
vertex.label = V(g)$name,
edge.label.cex=.75,
xlab='2nd graph'
)
Could someone please give an idea how to define mylayout2 for the second graph g2? I would like to use the original position of nodes from the mylayout. One of solution may be the using matrix E again. Unfortunately, I can't figure out how to use 0s from matrix E.
One of possible way is:
opE <- ifelse(E == 0, 1, 0)
cx <-rep(1:n, each = m)
cy <-rep(c(1:m), times = n)
cx <- cx * opE
cy <- cy * opE
cx <- cx[cx != 0]
cy <- cy[cy != 0]
mylayout2 <- as.matrix(cbind(cx, -cy))
plot(g2, layout=mylayout2,
vertex.shape = "square",
vertex.label = V(g)$name,
edge.label.cex=.75,
xlab='2nd graph'
)
Related
I have a igraph G, I need to sample two overlapping subgraphs G1, G2 and to plot them on the graph with the same layout.
My attempt is below:
library(igraph)
set.seed(1)
n <- 10
A <- matrix(sample(0:1, n * n, rep=TRUE), n, n)
diag(A) = 0
g <- graph_from_adjacency_matrix(A)
V(g)$names <- c(1:n)
id1 = sample(V(g), size = n %/% 2, replace = FALSE)
id2 = sample(V(g), size = n %/% 2, replace = FALSE)
g1 <- induced_subgraph(g, vids = id1)
g2 <- induced_subgraph(g, vids = id2)
V(g1)$names <- c(id1)
V(g2)$names <- c(id2)
#V(g)[id1]$color <- "red"
#V(g)[id2]$color <- "green"
par(mfrow=c(1,3))
layout <- layout.fruchterman.reingold(g)
plot(g, layout=layout, main="G")
plot(g1, layout = layout[-c(setdiff(1:n, id1)),], vertex.label=V(g)[id1], main="G1")
plot(g2, layout = layout[-c(setdiff(1:n, id2)),], vertex.label=V(g)[id2], main="G2")
My problem with ids and labels.
Question. How to plot the igraph subgraphs with saving the nodes' positions and ids?
Try the code below
library(igraph)
set.seed(1)
n <- 10
A <- matrix(sample(0:1, n * n, rep = TRUE), n, n)
diag(A) <- 0
g <- graph_from_adjacency_matrix(A)
id1 <- sort(as.integer(sample(V(g), size = n %/% 2, replace = FALSE)))
id2 <- sort(as.integer(sample(V(g), size = n %/% 2, replace = FALSE)))
g1 <- induced_subgraph(g, vids = id1)
g2 <- induced_subgraph(g, vids = id2)
par(mfrow = c(1,3))
layout <- layout.fruchterman.reingold(g)
layout2 <- layout[id2, ]
plot(g, layout = layout, main = "G")
plot(g1, layout = layout[id1, ], main = "G1")
plot(g2, layout = layout[id2, ], main = "G2")
I have a bipartite graph and I want the projections of this graph to have edge attributes that record via which nodes they were connected. For example:
require(igraph)
set.seed(123)
g <- sample_bipartite(5, 5, p =.5)
V(g)$name <- c(letters[1:5], 1:5)
g1 <- bipartite_projection(g)[[1]]
g2 <- bipartite_projection(g)[[2]]
par(mfrow = c(1, 3))
plot(g,
vertex.shape = ifelse(V(g)$type == FALSE, "square", "circle"),
vertex.color = ifelse(V(g)$type == FALSE, "gold", "tomato"),
main = "Bipartite")
plot(g1,
main = "Projection 1")
plot(g2,
main = "Projection 2")
par(mfrow = c(1, 1))
I want the information that I added by hand to the plot to be in the network object. It it easily done in igraph? Thanks.
With bipartite_projection
If you really want ot use bipartite_projection, you can try to define your custom function f like below:
f <- function(gp) {
df <- get.data.frame(gp)[1:2]
df$lbl <- apply(
df,
1,
function(v) {
max(do.call(intersect, unname(lapply(v, function(x) names(neighbors(g, x))))))
}
)
res <- graph_from_data_frame(df, directed = FALSE)
plot(res, edge.label = E(res)$lbl)
}
f(g1)
f(g2)
which gives
Without bipartite_projection
Below is an option without using bipartite_projection (take g1 as the an example, and g2 can be obtained in a similar way)
g1 <- simplify(
graph_from_data_frame(
do.call(
rbind,
lapply(
Filter(
function(x) nrow(x) > 1,
split(get.data.frame(g), ~to)
),
function(d) {
with(
d,
cbind(data.frame(t(combn(from, 2))), weight = unique(to))
)
}
)
),
directed = FALSE
),
edge.attr.comb = "max"
)
and plot(g1, edge.label = E(g1)$weight) gives
First, I made a dataframe of the as.edgelist results, then computed a label with paste0. Next, I used the edge_attr command to write the labels to the graph object.
el<-igraph::as_edgelist(g);el<-as.data.frame(el)
el$lab<-paste0(el$V1,"_",el$V2)
edge_attr(g,"label")<-el$lab
E(g)$label
set.seed(232)
plot(g,
edge.label.dist=.3,
edge.label.color="blue",
margin=-0.4,
layout=layout.fruchterman.reingold)
This is a tmp set of points with (x, y) coordinates and 0 or 1 categories.
tmp <- structure(list(cx = c(146.60916, 140.31737, 145.92917, 167.57799,
166.77618, 137.64381, 172.12157, 175.32881, 175.06154, 135.50566,
177.46696, 148.06731), cy = c(186.29814, 180.55231, 210.6084,
210.34111, 185.48505, 218.89375, 219.69554, 180.67421, 188.15775,
209.27205, 209.27203, 178.00151), category = c(1, 0, 1, 1, 1,
0, 0, 0, 0, 0, 0, 0)), class = "data.frame", row.names = c(NA,
-12L))
I need to find the minimum spanning tree for category = 1 points, then to join (add edge) each point with category = 0 to its nearest category = 1 point.
The minimum spanning tree is built on points with the category = 1.
ones <- tmp[tmp$category == 1,]
n <- dim(ones)[1]
d <- matrix(0, n, n)
d <- as.matrix(dist(cbind(ones$cx, ones$cy)))
g1 <- graph.adjacency(d, weighted=TRUE, mode="undirected")
V(g1)$name <- tmp[tmp$category == 1,]$Name
mylayout = as.matrix(cbind(ones$cx, -ones$cy))
mst <- minimum.spanning.tree(g1) # Find a minimum spanning tree
plot(mst, layout=mylayout,
vertex.size = 10,
vertex.label = V(g1)$name,
vertex.label.cex =.75,
edge.label.cex = .7,
)
Expected result is in center of figure.
My current attempt is:
n <- dim(tmp)[1]
d <- matrix(0, n, n)
d <- as.matrix(dist(cbind(tmp$cx, tmp$cy)))
d[tmp$category %*% t(tmp$category) == 1] = Inf
d[!sweep(d, 2, apply(d, 2, min), `==`)] <- 0
g2 <- graph.adjacency(d, weighted=TRUE, mode="undirected")
mylayout = as.matrix(cbind(tmp$cx, -tmp$cy))
V(g2)$name <- tmp$Name
plot(g2, layout=mylayout,
vertex.size = 10,
vertex.label = V(g2)$name,
vertex.label.cex =.75,
edge.label = round(E(g2)$weight, 3),
edge.label.cex = .7,
)
One can see that I have found the minimum dist and add one edge only.
Question. How to define condition for all possible points?
You can try the code below
# two categories of point data frames
pts1 <- subset(tmp, category == 1)
pts0 <- subset(tmp, category == 0)
# generate minimum spanning tree `gmst`
gmst <- mst(graph_from_adjacency_matrix(as.matrix(dist(pts1[1:2])), mode = "undirected", weighted = TRUE))
# distance matrix between `pts0` and `pts1`
pts0_pts1 <- as.matrix(dist(tmp[1:2]))[row.names(pts0), row.names(pts1)]
# minimum distances of `pts0` to `pts1`
idx <- max.col(-pts0_pts1)
df0 <- data.frame(
from = row.names(pts0),
to = row.names(pts1)[idx],
weight = pts0_pts1[cbind(1:nrow(pts0), idx)]
)
# aggregate edges lists and produce final result
g <- graph_from_data_frame(rbind(get.data.frame(gmst), df0), directed = FALSE) %>%
set_vertex_attr(name = "color", value = names(V(.)) %in% names(V(gmst)))
mylayout <- as.matrix(tmp[names(V(g)), 1:2]) %*% diag(c(1, -1))
plot(g, edge.label = round(E(g)$weight, 1), layout = mylayout)
and you will get
I have a graph, G=(V,E) with several attributes including an edge weight attribute. I'm trying to create a subgraph based on a condition where weights are higher than x.
I've tried the standard R subsetting option with g <- E(g)[weight > max(weight)*.10], but I always get a vector.
I'm not sure what I'm doing wrong here.
Maybe you want something like this
library(igraph)
set.seed(1)
m <- matrix(sample(c(.5, 2, 5), 100, replace=T, prob = c(.6,.3,.1)), nc=10, dimnames = rep(list(letters[1:10]), 2))
g <- graph_from_adjacency_matrix(m, weighted=T, diag=F, mode="undirected")
coords <- layout.auto(g)
par(mfrow = c(1,3))
plot(g, layout=coords, edge.width = E(g)$weight)
s1 <- subgraph.edges(g, E(g)[E(g)$weight>2], del=F)
plot(s1, layout=coords, edge.width = E(s1)$weight)
s2 <- delete_vertices(s1, degree(s1, mode = "in")==0)
plot(s2, layout=coords[V(g)$name%in%V(s2)$name,], edge.width = E(s2)$weight)
That would be because you replaced your graph g with just subsetted edges. If you want to remove edges below the threshold weight, you can use:
g_sub <- delete.edges(g, E(g)[weight <= max(weight)*.10])
I am trying to calculate a normalized local closeness centrality. But setting the parameter normalized = T for igraph::estimate_closeness() only multiplies the results with (N-1). Is it possible to define N_i for vertex i individually by it's neighborhood, that is determined by the cut-off parameter (and of course by the graph itself)?
The mini example demonstrates, that setting the parameter normalized=T does not work for this purpose. It normalizes with one and the same (N-1) for all vertices.
Thanks for help.
set.seed(1210)
require('igraph')
g <- random.graph.game(20,3/10)
g <- set.edge.attribute(g, "weight", value= 1)
cnt <- estimate_closeness(g, cutoff = 3, normalized = T );cnt
cnf <- estimate_closeness(g, cutoff = 3, normalized = F );cnf
#print results
cbind(cnf * (length(V(g))-1), cnt)
sum(abs(cnf * (length(V(g))-1) - cnt))
#for visualization
V(g)$name <- paste("v", 1:length(V(g)), sep="")#letters[1:length(V(g))]
set.seed(2)
lay <- layout.auto(g)
## set plotting parameters
vs <- 15# vertex.size
ec <- gray(0.8)#edge.color
elx <- 2# edge.label.cex
elc <- "black"#,edge.label.color
vlc <- 2#vertex.label.cex
ew <- 2#edge.width
hd <- paste(rep(" ",0), collapse="")
cm <- 3
vc <- "orange"#gray(0.8)#palette("default")#"grey"#vertex.color
windows(width = 18, height=6)
par(mfrow=c(1,3))
plot(g, edge.label=paste(hd, round(E(g)$weight,1)), layout=lay, vertex.size=vs, edge.color=ec, edge.label.cex=elx, vertex.label.cex=vlc, edge.width=ew, edge.label.color=elc, vertex.color=vc)
title("(a) Weights", cex.main = cm)
V(g)$name <- paste(round(cnt,3))
plot(g, layout=lay, vertex.size=vs, edge.color=ec, edge.label.cex=elx, vertex.label.cex=vlc, edge.width=ew, edge.label.color=elc, vertex.color=vc)
title("(b) local closeness normalized", cex.main = cm)
V(g)$name <- paste(round(cnf,3))
plot(g, layout=lay, vertex.size=vs, edge.color=ec, edge.label.cex=elx, vertex.label.cex=vlc, edge.width=ew, edge.label.color=elc, vertex.color=vc)
title("(c) local closeness", cex.main = cm)