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.

## No comments:

## Post a Comment