[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [igraph] Turn a directed network into a weighted undirected network
From: |
MikeS |
Subject: |
Re: [igraph] Turn a directed network into a weighted undirected network |
Date: |
Wed, 22 Jun 2016 13:28:50 +0700 |
Hello,
my current code is below.
Could someone please test the code? And give comments how to optimize
it. Can I use some build-in function of igraph?
library(igraph)
set.seed(42)
par(mfrow=c(1,2))
d <- matrix(c(0,1,0,1,0, 0,0,1,1,1, 1,1,0,0,1,
0,1,1,0,1,1,1,1,0,0),nrow=5,ncol=5)
G <- graph.adjacency(d)
V(G)$name <- letters[1:dim(d)[1]]
V(G)$shape = "none"
g_layout <- layout.davidson.harel(G)
plot(G, edge.arrow.size=0.5, edge.curved=FALSE, layout=g_layout)
# Here are the adjacency matrices for each of the four subgraphs
d0<-matrix(c(0,1,0,0,0,1,1,0,0),nrow=3,ncol=3)
d1<-matrix(c(0,1,0,0,0,1,1,1,0),nrow=3,ncol=3)
d2<-matrix(c(0,1,0,1,0,1,1,1,0),nrow=3,ncol=3)
d3<-matrix(c(0,1,1,1,0,1,1,1,0),nrow=3,ncol=3)
# Turn them into a convenient list
sbgCycle.mat<-list(d0,d1,d2,d3)
n <- length(list(d0,d1,d2,d3))
# And then into a list of graph objects
pattern <- lapply(sbgCycle.mat, graph.adjacency)
# 1. Convert the directed graph to undirected one
UG <- simplify(G)
UG <- as.undirected(UG)
# 2. Search for triangles in the undirected graph
triangle <- graph.full(3)
# names of incident vertices of triangle in the undirected graph
sbg.triangle <- unique(graph.get.subisomorphisms.vf2(UG, triangle))
k <- length(sbg.triangle)
vertices_of_triangle <- function (x) { c(x[1], x[2], x[2], x[3],
x[3], x[1]) }
vlist <- lapply(1:k, function(y) vertices_of_triangle(sbg.triangle[[y]]) )
# 3. Search for subisomorphisms in the directed graph to all of
the four templates
subisom1 <- subgraph_isomorphisms(pattern[[1]], G, method="lad",
induced=TRUE)
subisom2 <- subgraph_isomorphisms(pattern[[2]], G, method="lad",
induced=TRUE)
subisom3 <- subgraph_isomorphisms(pattern[[3]], G, method="lad",
induced=TRUE)
subisom4 <- subgraph_isomorphisms(pattern[[4]], G, method="lad",
induced=TRUE)
# 4. For each triangle check which pattern it was isomorphic
vertices_of_cycle <- function(x) { c(x[1], x[2], x[3], x[1]) }
if (length(subisom1)>0){
for(j in 1:length(subisom1) ) {
cycle <- as.vector(vertices_of_cycle(subisom1[[j]]))
E(UG, path = cycle)$weight <- 1
} # for_j
}
if (length(subisom2)>0){
for(j in 1:length(subisom2) ) {
cycle <- as.vector(vertices_of_cycle(subisom2[[j]]))
E(UG, path = cycle)$weight <- 2
} # for_j
}
if (length(subisom3)>0){
for(j in 1:length(subisom3) ) {
cycle <- as.vector(vertices_of_cycle(subisom3[[j]]))
E(UG, path = cycle)$weight <- 3
} # for_j
}
if (length(subisom4)>0){
for(j in 1:length(subisom4) ) {
cycle <- as.vector(vertices_of_cycle(subisom4[[j]]))
E(UG, path = cycle)$weight <- 4
} # for_j
}
plot(UG, edge.arrow.size=0.2, edge.label=E(UG)$weight, layout=g_layout)
--
MikeS