graphr: Random Graph Generation

#' Adjacency matrix version of pairing algorithm for generating graphs of a
#'   given degree sequence
#'
#' \code{given_degree_matrix} creates an adjacency matrix representation of an
#'   undirected graph generated with a given degree sequence
#'
#' This functon generates an undirected random graph of size \code{N}, each node
#'   having degree given by the user. The code only generates "simple" graphs:
#'   Self and repeated edges are not permitted.  For this reason
#'   so for speed reasons checks are performed during edge creation.
#'
#' @note For speed reasons, checks are performed during an edge creation to
#'   ensure the pairing does not create a loop nor multiple edges between the
#'   same nodes. This may introduce some bias in the algorithm.  I need to read
#'   up on this but for the time being I think this is ok.
#'
#' @param N Number of vertices / nodes in the network.
#' @param degree number of neighbours of each node.
#' @return adjacency matrix representation of the resultant network
#' @examples
#' N <- 1000
#' degree <- rep(2, N)
#' gr <- given_degree_matrix(N, degree)
#' @export
given_degree_matrix <- function(N, degree, max_iterations = 1000) {

  # check for even number of stubs
  num_stubs <- sum(degree)
  stopifnot((num_stubs %% 2) == 0)

  # expand nodes and generate empty matrix
  nodes <- seq_len(N)
  stubs <- rep(nodes, times = degree)
  network <- matrix(0L, nrow = N, ncol = N)

  # variable to keep track of edge attempts
  edge_attempts <- 0

  # variable to keep track of iterations
  iter <- 0

  while ((length(stubs) > 0) && (iter < max_iterations)) {

    edge_attempts <- edge_attempts + 1

    # choose a pair of stubs
    pair <- sample(length(stubs), 2, replace = FALSE)
    node_a <- stubs[pair[1]]
    node_b <- stubs[pair[2]]

    # check if nodes are the same or already connected
    if ((node_a == node_b) || (network[node_a, node_b] == 1)) {

      # start another iteration if taking too many attempts
      if (edge_attempts == num_stubs) {
        stubs <- rep(nodes, times = degree)
        network <- matrix(0L, nrow = N, ncol = N)
        edge_attempts <- 0
        iter <- iter + 1
      }
    } else {
      # connect nodes and remove stubs from list
      network[node_a, node_b] <- 1L
      network[node_b, node_a] <- 1L
      stubs <- stubs[-pair]
    }
  }

  if (iter == max_iterations) {
    stop("Unable to make graph")
  } else {
    return(network)
  }

}


#' Adjacency list version of pairing algorithm for generating graphs of a
#'   given degree sequence
#'
#' \code{given_degree_list} creates an adjacency matrix representation of an
#'   undirected graph generated with a given degree sequence
#'
#' This functon generates an undirected random graph of size \code{N}, each node
#'   having degree given by the user. The code only generates "simple" graphs:
#'   Self and repeated edges are not permitted.  For this reason
#'   so for speed reasons checks are performed during edge creation.
#'
#' @note For speed reasons, checks are performed during an edge creation to
#'   ensure the pairing does not create a loop nor multiple edges between the
#'   same nodes. This may introduce some bias in the algorithm.  I need to read
#'   up on this but for the time being I think this is ok.
#'
#' @param N Number of vertices / nodes in the network.
#' @param degree number of neighbours of each node.
#' @return adjacency list representation of the resultant network
#' @examples
#' N <- 1000
#' degree <- rep(2, N)
#' gr <- given_degree_list(N, degree)
#' @export
given_degree_list <- function(N, degree, max_iterations = 1000) {

  # check for even number of stubs
  num_stubs <- sum(degree)
  stopifnot((num_stubs %% 2) == 0)

  # expand nodes and generate empty list
  nodes <- seq_len(N)
  stubs <- rep(nodes, times = degree)
  network <- vector("list", N)

  # initialise list for better behaviour and compatibility with c++ code
  for (i in 1:N) {
    network[[i]] <- integer()
  }

  # vector to keep track of number of neighbours for list entry
  neighbours <- rep(0, N)

  # variable to keep track of edge attempts
  edge_attempts <- 0

  # variable to keep track of iterations
  iter <- 0

  while ((length(stubs) > 0) && (iter < max_iterations)) {

    edge_attempts <- edge_attempts + 1

    # choose a pair of stubs
    pair <- sample(length(stubs), 2, replace = FALSE)
    node_a <- stubs[pair[1]]
    node_b <- stubs[pair[2]]

    # check if nodes are the same or already connected
    if ((node_a == node_b) || (node_b %in% network[[node_a]])) {

      # start another iteration if taking too many attempts
      if (edge_attempts == num_stubs) {
        stubs <- rep(nodes, times = degree)
        for (i in 1:N) {
          network[[i]] <- integer()
        }
        edge_attempts <- 0
        neighbours <- rep(0, N)
        iter <- iter + 1
      }
    } else {
      # connect nodes and remove stubs from list
      neighbours[node_a] <- neighbours[node_a] + 1
      neighbours[node_b] <- neighbours[node_b] + 1
      network[[node_a]][neighbours[node_a]] <- node_b
      network[[node_b]][neighbours[node_b]] <- node_a
      stubs <- stubs[-pair]
    }
  }

  if (iter == max_iterations) {
    stop("Unable to make graph")
  } else {
    return(network)
  }

}