R/ergm.getnetwork.R

In statnet/ergm: Fit, Simulate and Diagnose Exponential-Family Models for Networks

#  File R/ergm.getnetwork.R in package ergm, part of the Statnet suite of
#  packages for network analysis, https://statnet.org .
#
#  This software is distributed under the GPL-3 license.  It is free, open
#  source, and has the attribution requirements (GPL Section 7) at
#  https://statnet.org/attribution .
#
#  Copyright 2003-2025 Statnet Commons
################################################################################
#################################################################################
# The <ergm.getnetwork> function ensures that the network in a given formula
# is valid; if so, the network is returned; if not, execution is halted with
# warnings
#
# --PARAMETERS--
#   formula     :  the formula as 'network ~ model.term(s)'
#   loopswarning:  whether warnings about loops should be printed (T or F);
#                  default=TRUE
#
# --RETURNED--
#   nw: the network from the formula IF (i) the formula was correctly structured
#       and (ii) the network is found within the formula's enviornment
#
###################################################################################

#' Acquire and verify the network from the LHS of an `ergm` formula
#' and verify that it is a valid network.
#' 
#' The function function ensures that the network in a given formula
#' is valid; if so, the network is returned; if not, execution is
#' halted with warnings.
#'
#' @param formula a two-sided formula whose LHS is a [`network`], an object
#'   that can be coerced to a [`network`], or an expression that evaluates
#'   to one.
#' @param loopswarning whether warnings about loops should be printed
#'   (`TRUE` or `FALSE`); defaults to value of option `ergm.warn_loops`
#'   or `TRUE`.
#' 
#' @return A [`network`] object constructed by evaluating the LHS of
#'   the model formula in the formula's environment.
#' @export ergm.getnetwork
ergm.getnetwork <- function (formula, loopswarning=getOption("ergm.warn_loops")){
  nw <- eval_lhs.formula(formula)
  nw <- ensure_network(nw)

  if (loopswarning) {
    e <- as.edgelist(nw)
    if(any(e[,1]==e[,2])) {
      warning("This network contains loops")
    } else if (has.loops(as.network(nw,populate=FALSE))) {
      warning("This network is allowed to contain loops")
    }
  }
  nw
}

ensure_network <- function(nw){
  if(!is.network(nw) && !is.ergm_state(nw)){
    nw <- ERRVL2(
      as.network(nw),
      abort("A network object on the LHS of the formula or as a basis argument must be given")
    )
  }
  nw
}