0byt3m1n1
Path:
C:
/
Program Files
/
R
/
R-4.2.2
/
library
/
igraph
/
demo
/
[
Home
]
File: smallworld.R
pause <- function() {} ### Create a star-like graph t1 <- graph_from_literal(A - B:C:D:E) t1 pause() ### Define its plotting properties t1$layout <- layout_in_circle V(t1)$color <- "white" V(t1)[name == "A"]$color <- "orange" V(t1)$size <- 40 V(t1)$label.cex <- 3 V(t1)$label <- V(t1)$name E(t1)$color <- "black" E(t1)$width <- 3 pause() ### Plot 't1' and A's transitivity tr <- transitivity(t1, type = "local")[1] plot(t1, main = paste("Transitivity of 'A':", tr)) pause() ### Add an edge and recalculate transitivity t2 <- add_edges(t1, V(t1)[name %in% c("C", "D")], color = "red", width = 3) tr <- transitivity(t2, type = "local")[1] plot(t2, main = paste("Transitivity of 'A':", round(tr, 4))) pause() ### Add two more edges newe <- match(c("B", "C", "B", "E"), V(t2)$name) - 1 t3 <- add_edges(t2, newe, color = "red", width = 3) tr <- transitivity(t3, type = "local")[1] plot(t3, main = paste("Transitivity of 'A':", round(tr, 4))) pause() ### A one dimensional, circular lattice ring <- make_ring(50) ring$layout <- layout_in_circle V(ring)$size <- 3 plot(ring, vertex.label = NA, main = "Ring graph") pause() ### Watts-Strogatz model ws1 <- sample_smallworld(1, 50, 3, p = 0) ws1$layout <- layout_in_circle V(ws1)$size <- 3 E(ws1)$curved <- 1 plot(ws1, vertex.label = NA, main = "regular graph") pause() ### Zoom in to this part axis(1) axis(2) abline(h = c(0.8, 1.1)) abline(v = c(-0.2, 0.2)) pause() ### Zoom in to this part plot(ws1, vertex.label = NA, xlim = c(-0.2, 0.2), ylim = c(0.8, 1.1)) pause() ### Transitivity of the ring graph transitivity(ws1) pause() ### Path lengths, regular graph mean_distance(ws1) pause() ### Function to test regular graph with given size try.ring.pl <- function(n) { g <- sample_smallworld(1, n, 3, p = 0) mean_distance(g) } try.ring.pl(10) try.ring.pl(100) pause() ### Test a number of regular graphs ring.size <- seq(100, 1000, by = 100) ring.pl <- sapply(ring.size, try.ring.pl) plot(ring.size, ring.pl, type = "b") pause() ### Path lengths, random graph rg <- sample_gnm(50, 50 * 3) rg$layout <- layout_in_circle V(rg)$size <- 3 plot(rg, vertex.label = NA, main = "Random graph") mean_distance(rg) pause() ### Path length of random graphs try.random.pl <- function(n) { g <- sample_gnm(n, n * 3) mean_distance(g) } try.random.pl(100) pause() ### Plot network size vs. average path length random.pl <- sapply(ring.size, try.random.pl) plot(ring.size, random.pl, type = "b") pause() ### Plot again, logarithmic 'x' axis plot(ring.size, random.pl, type = "b", log = "x") pause() ### Transitivity, random graph, by definition ecount(rg) / (vcount(rg) * (vcount(rg) - 1) / 2) transitivity(rg, type = "localaverage") pause() ### Rewiring ws2 <- sample_smallworld(1, 50, 3, p = 0.1) ws2$layout <- layout_in_circle V(ws2)$size <- 3 plot(ws2, vertex.label = NA) mean_distance(ws2) pause() ### Path lengths in randomized lattices try.rr.pl <- function(n, p) { g <- sample_smallworld(1, n, 3, p = p) mean_distance(g) } rr.pl.0.1 <- sapply(ring.size, try.rr.pl, p = 0.1) plot(ring.size, rr.pl.0.1, type = "b") pause() ### Logarithmic 'x' axis plot(ring.size, rr.pl.0.1, type = "b", log = "x") pause() ### Create the graph in the Watts-Strogatz paper ws.paper <- function(p, n = 1000) { g <- sample_smallworld(1, n, 10, p = p) tr <- transitivity(g, type = "localaverage") pl <- mean_distance(g) c(tr, pl) } pause() ### Do the simulation for a number of 'p' values rewire.prob <- ((1:10)^4) / (10^4) ws.result <- sapply(rewire.prob, ws.paper) dim(ws.result) pause() ### Plot it plot(rewire.prob, ws.result[1, ] / ws.result[1, 1], log = "x", pch = 22, xlab = "p", ylab = "" ) points(rewire.prob, ws.result[2, ] / ws.result[2, 1], pch = 20) legend("bottomleft", c(expression(C(p) / C(0)), expression(L(p) / L(0))), pch = c(22, 20) )