[igraph] Randomizing graph while maintaining some properties

[Steve Lianoglou]

Hi all,

I was curious if there was a good way to randomize an input graph
while keeping some things constant (like degree distro on edges, for
one).

I wrote a naive/convoluted method that I'm using to attempt to do this
on undirected graphs (pasted below), but it really fails to do it
properly, though I guess it's ok for my requirements. Is there a
better way to go?

Thanks,
-steve

graph.randomize.edges <- function(graph, attr=NULL, do.test=TRUE) {
  # Randomizes the connections in the graph keeping the same degree/
node
  #
  # NOTE: All graph attributes will be stripped, it's your job to use
  #       the *.annotate.* functions to put the ones back that you
want.
  warning(paste("This method doesn't keep the exact degree
distributions",
                "as the original graph, even though it's trying to!"))
  mode <- ifelse(is.directed(graph), 'directed', 'upper')
  adj <- get.adjacency(graph, attr=attr)
  new.adj <- matrix(0, nrow(adj), ncol(adj), dimnames=dimnames(adj))
  degrees <- rowSums(adj)

  if (mode == 'directed') {
    for (i in 1:nrow(adj)) {
      new.adj[i,] <- sample(adj[i,])
    }
  } else {
    weights <- adj[upper.tri(adj, diag=TRUE)]   # Use the same weights
from old
    weights <- weights[weights != 0]            # graph on new random
edges
    so.far <- 0
    idxs <- upper.tri(adj, diag=TRUE)
    for (i in 1:nrow(adj)) {
      if (so.far >= length(weights)) {
        break
      }
      already.connected <- which(new.adj[,i] != 0)
      n.to.put <- degrees[i] - length(already.connected)
      # cat("[", i, "]: ", n.to.put, '\n', sep='')
      if (n.to.put > 0) {
        take.start <- so.far + 1
        take.weights <- weights[take.start:(take.start + n.to.put -
1)]
        so.far <- so.far + length(take.weights)
        n.zeros <- ncol(adj) - (i-1) - length(take.weights)
        edge.weights <- sample(c(take.weights, rep(0, n.zeros)))
        if (any(is.na(edge.weights))) {
          # oversampled the edges, the loop will break in the next
iter
          warning("NA/NA/NA")
        }
        new.adj[i,i:ncol(adj)] <- edge.weights
      }
    }
    new.adj[is.na(new.adj)] <- 0              # correction for
oversampling

    d <- diag(new.adj)
    new.adj <- new.adj + t(new.adj)
    diag(new.adj) <- d
  }

  g.rand <- graph.adjacency(new.adj, mode=mode, weighted=TRUE)

  if (do.test) {
    # Checks that graph has same number of edges
    n.edges <- sum(degree(graph)) == sum(degree(g.rand))
    if (!n.edges) {
      warning("Not the same number of edges")
    }

    eq <- all(degree(graph) == degree(g.rand))
    if (!all(eq)) {
      warning("Degrees for each node don't match")
    }

    # Check for broken pieces
    if (no.clusters(graph) != no.clusters(g.rand)) {
      warning("Number of pieces in graphs don't match!")
    }
  }

  g.rand
}