(This article was first published on

There are two limitations of Watts-Strogatz network generator in igraph package: (1) it works only for undirected graphs and (2) rewiring algorithm can produce loops or multiple edges.**R snippets**, and kindly contributed to R-bloggers)You can use simplify function of such a graph, but then number of edges in the graph is reduced.

Below I give ws.graph function that generates directed graph without these problems:

library(igraph)

library(colorspace)

resample <- function(x, ...) {

x[sample.int(length(x), ...)]

}

ws.graph <- function(n, nei, p) {

stopifnot(nei < n)

edge.list <- vector("list", n)

for (v in 0:(n-1)) {

edge.end <- union((v + 1:nei) %% n,

(v + (-1:-nei)) %% n)

rewire <- (runif(length(edge.end)) < p)

edge.end <- edge.end[!rewire]

rewired <- resample(setdiff(0 : (n-1),

c(edge.end, v)), sum(rewire))

edges <- rep(v, 4 * nei)

edges[c(F, T)] <- c(edge.end, rewired)

edge.list[[v + 1]] <- edges

}

graph(unlist(edge.list))

}

n <- 8

nei <- 2

p.levels <- c(0, 0.25, 0.5, 1)

reps <- 2^16

m <- matrix(0, nrow = n, ncol = n)

m <- list(m, m, m, m)

for (i in 1:reps) {

for (j in seq_along(p.levels)) {

g <- ws.graph(n, nei, p.levels[j])

m[[j]] <- m[[j]] + get.adjacency(g)

}

}

x <- rep(1:n, n)

y <- rep(1:n, each = n)

par(mfrow = c(2, 2), mar= c(5, 5, 2, 2))

for (i in 1:4) {

mc <- as.vector(m[[i]]) / reps

mc <- cbind(mc, mc, mc)

mc <- 1 - mc

plot(x, y, col = hex(RGB(mc)), pch = 19, ylab = "",

xlab = paste("p =", round(p.levels[i], 4)), cex = 1.5)

}

This is the resulting plot:

As expected increasing rewiring probability to 1 makes edge probability distribution more uniform.

To

**leave a comment**for the author, please follow the link and comment on his blog:**R snippets**.R-bloggers.com offers

**daily e-mail updates**about R news and tutorials on topics such as: visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more...