#' @title Affiliation network structure
#'
#' @description Test \code{igraph} objects for affiliation network structure or
#' impose such structure if possible.
#'
#' @details An affiliation network is a bipartite graph whose nodes are
#' classified as actors and events in such a way that all links are between
#' actors and events. The function \code{\link[igraph]{is_bipartite}} tests an
#' `igraph` object for a \code{type} attribute, which is intended to
#' bipartition of the nodes. It does not test whether the links respect this
#' partition. The function \code{is_an} tests this, as well as the condition
#' that actor nodes precede event nodes in their node IDs, which simplifies
#' some other functions. The function \code{as_an} coerces an `igraph` object
#' to an affiliation network by verifying that the object is bipartite and
#' minimally permuting the node IDs. If \code{graph} has no \code{type}
#' attribute and \code{add.type.attribute} is \code{FALSE}, then \code{as_an}
#' throws an error; if \code{add.type.attribute} is \code{TRUE}, then
#' \code{as_an} introduces a logical \code{type} attribute that takes the
#' value \code{FALSE} at the first node (by node ID) in each connected
#' component and \code{TRUE} or \code{FALSE} at the remaining nodes according
#' as they are an odd or even number of hops from the first.
#'
#' @name affiliation_network
#' @family network testing and coercion
#' @seealso Original \strong{igraph} functions: \code{\link{is_igraph}}
#' @param graph An \code{igraph} object.
#' @param add.type.attribute Logical; whether to introduce a \code{type}
#' attribute if \code{graph} has none before testing for bipartite structure.
NULL
#' @rdname affiliation_network
#' @export
is_an <- function(graph) {
if (!is_igraph(graph)) return(FALSE)
if (!is_simple(graph)) return(FALSE)
if (is_directed(graph)) return(FALSE)
if (!("type" %in% vertex_attr_names(graph))) return(FALSE)
if (is.unsorted(V(graph)$type)) return(FALSE)
el <- as_edgelist(graph, names = FALSE)
all(as.numeric(V(graph)$type[el[, 1]]) +
as.numeric(V(graph)$type[el[, 2]]) == 1)
}
#' @rdname affiliation_network
#' @export
is.an <- is_an
#' @rdname affiliation_network
#' @export
as_an <- function(graph, add.type.attribute = FALSE) {
if (!is_igraph(graph)) stop("Not an igraph object.")
if (!is_simple(graph)) {
graph <- simplify(graph)
}
if (is_directed(graph)) {
warning("Graph is directed; collapsing directed links.")
graph <- as.undirected(graph, mode = "collapse")
}
if (!("type" %in% vertex_attr_names(graph))) {
if (add.type.attribute) {
graph <- try_type(graph)
} else {
stop("Needs 'type' attribute.")
}
}
el <- as_edgelist(graph, names = FALSE)
if (!all(as.numeric(V(graph)$type[el[, 1]]) +
as.numeric(V(graph)$type[el[, 2]]) == 1)) {
stop("Attribute 'type' does not form a bipartition.")
}
permute(graph, order(order(V(graph)$type)))
}
#' @rdname affiliation_network
#' @export
as.an <- as_an
try_type <- function(graph) {
comps <- components(graph)
start_nodes <- which(!duplicated(comps$membership))
dist_mat <- distances(graph, v = start_nodes, weights = NA)
dist_mat[is.infinite(dist_mat)] <- NA
dists <- apply(dist_mat, 2, sum, na.rm = TRUE)
vertex_attr(graph) <- c(vertex_attr(graph), list("type" = logical(0)))
graph
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.