#' Network data formats
#'
#' List of accepted graph formats
#'
#' @name netdiffuseR-graphs
#' @details The \pkg{netdiffuseR} package can handle different types of graph
#' objects. Two general classes are defined across the package's functions:
#' static graphs, and dynamic graphs.
#' \itemize{
#' \item{In the case of \strong{static graphs}, these are represented as adjacency
#' matrices of size \eqn{n\times n}{n * n} and can be either \code{\link{matrix}}
#' (dense matrices) or \code{\link[Matrix:dgCMatrix-class]{dgCMatrix}}
#' (sparse matrix from the \pkg{\link[Matrix:Matrix]{Matrix}} package). While
#' most of the package functions are defined for both classes, the default output
#' graph is sparse, i.e. \code{dgCMatrix}.}
#' \item{With respect to \strong{dynamic graphs}, these are represented by either
#' a \code{\link{diffnet}} object, an \code{\link{array}} of size
#' \eqn{n\times n \times T}{n * n * T}, or a list of size \eqn{T}
#' with sparse matrices (class \code{dgCMatrix}) of size \eqn{n\times n}{n * n}.
#' Just like the static graph case, while most of the functions accept both
#' graph types, the default output is \code{dgCMatrix}.}
#' }
#' @section diffnet objects:
#' In the case of \code{diffnet}-class objects, the following arguments can be omitted
#' when calling fuictions suitable for graph objects:
#' \itemize{
#' \item{\code{toa}: Time of Adoption vector}
#' \item{\code{adopt}: Adoption Matrix}
#' \item{\code{cumadopt}: Cumulative Adoption Matrix}
#' \item{\code{undirected}: Whether the graph is directed or not}
#' }
#'
#' @section Objects' names:
#' When possible, \pkg{netdiffuseR} will try to reuse graphs dimensional names,
#' this is, \code{\link{rownames}}, \code{\link{colnames}}, \code{\link{dimnames}}
#' and \code{\link{names}} (in the case of dynamic graphs as lists). Otherwise,
#' when no names are provided, these will be created from scratch.
#' @include imports.r
#' @return No return value (this manual entry only provides information).
#' @author George G. Vega Yon
#' @family graph formats
NULL
as_generic_graph <- function(graph) UseMethod("as_generic_graph")
# Method for igraph objects
as_generic_graph.igraph <- function(graph) {
# If multiple then warn
if (igraph::any_multiple(graph))
warning("The -igraph- object has multiple edges. Only one of each will be retrieved.")
if ("weight" %in% igraph::graph_attr_names(graph)) {
adjmat <- igraph::as_adj(graph, attr="weight")
} else {
adjmat <- igraph::as_adj(graph)
}
# Converting to dgCMatrix
env <- environment()
ans <- new_generic_graph()
suppressWarnings(add_to_generic_graph("ans", "graph", list(`1`=adjmat), env))
meta <- c(classify_graph(adjmat), list(
self = any(igraph::is.loop(graph)),
undirected = FALSE, # For now we will assume it is undirected
multiple = FALSE, # And !multiple
class = "igraph"
))
add_to_generic_graph("ans", "meta", meta, env)
return(ans)
}
new_generic_graph <- function() {
list(graph=NULL, meta=NULL)
}
# This function adds an element checking that the slot exits
add_to_generic_graph <- function(gg,nam,val,env=environment()) {
obj <- get(gg, envir = env)
if (!(nam %in% names(obj))) stop(nam," unknown slot.")
obj[[nam]] <- val
assign(gg,obj,envir = env)
invisible(NULL)
}
# Method for network objects
as_generic_graph.network <- function(graph) {
# If multiple then warn
if (network::is.multiplex(graph))
warning("The -network- object has multiple edges. These will be added up.")
# Converting to an adjacency matrix (dgCMatrix)
adjmat <- edgelist_to_adjmat(
network::as.edgelist(graph),
undirected = !network::is.directed(graph),
multiple = network::is.multiplex(graph),
self = network::has.loops(graph)
)
ord <- network::network.vertex.names(graph)
ord <- match(ord, rownames(adjmat))
adjmat <- adjmat[ord,ord]
env <- environment()
ans <- new_generic_graph()
suppressWarnings(add_to_generic_graph("ans", "graph", list(`1`=adjmat), env))
meta <- c(classify_graph(adjmat), list(
self = network::has.loops(graph),
undirected = !network::is.directed(graph),
multiple = network::is.multiplex(graph),
class = "network"
))
add_to_generic_graph("ans", "meta", meta, env)
return(ans)
}
stopifnot_graph <- function(x)
stop("No method for graph of class -",class(x),"- for ", deparse(sys.call()) #match.call()
,". Please refer to the manual 'netdiffuseR-graphs'.")
#' Analyze an R object to identify the class of graph (if any)
#' @template graph_template
#' @details This function analyzes an R object and tries to classify it among the
#' accepted classes in \pkg{netdiffuseR}. If the object fails to fall in one of
#' the types of graphs the function returns with an error indicating what (and
#' when possible, where) the problem lies.
#'
#' The function was designed to be used with \code{\link{as_diffnet}}.
#' @seealso \code{\link{as_diffnet}}, \code{\link{netdiffuseR-graphs}}
#' @return Whe the object fits any of the accepted graph formats, a list of attributes including
#' \item{type}{Character scalar. Whether is a static or a dynamic graph}
#' \item{class}{Character scalar. The class of the original object}
#' \item{ids}{Character vector. Labels of the vertices}
#' \item{pers}{Integer vector. Labels of the time periods}
#' \item{nper}{Integer scalar. Number of time periods}
#' \item{n}{Integer scalar. Number of vertices in the graph}
#' Otherwise returns with error.
#' @author George G. Vega Yon
#' @export
classify_graph <- function(graph) {
# Diffnet object
if (inherits(graph, "diffnet")) {
return(classify_graph(graph$graph))
} else if (inherits(graph, "matrix") || inherits(graph, "dgCMatrix")) { # Static graphs
# Step 0: Should have length
d <- dim(graph)
if (!d[1])
stop("Nothing to do. Empty matrix.")
# Step 1: Should be square
if (d[1] != d[2])
stop("-graph- must be a square matrix\n\tdim(graph) = c(",
paste0(d, collapse=","),").")
# Step 3: Should be numeric
m <- mode(graph)
if (!inherits(graph, "dgCMatrix") && !(m %in% c("numeric", "integer")))
stop("-graph- should be either numeric or integer.\n\tmode(graph) = \"",
m, "\".")
# Step 4: Dimension names
ids <- rownames(graph)
if (!length(ids)) ids <- 1:d[1]
return(invisible(list(
type="static",
class="matrix",
ids=ids,
pers=1,
nper=1,
n=d[1]
)))
}
# Dynamic graphs (list) ------------------------------------------------------
else if (inherits(graph, "list")) {
# Step 0: Should have length!
t <- length(graph)
if (t < 2)
stop("-graph- must be at least of length 2.")
# Step 1: All should be of class -dgCMatrix-
c <- sapply(graph, inherits, "dgCMatrix")
if (!all(c))
stop("The following elements are not of class -dgCMatrix-:\n\t",
paste0(which(!c), collapse=", "),".")
# Step 2.1: All must be square matrices
d <- lapply(graph, dim)
s <- sapply(d, function(x) x[1] == x[2])
# Step 2.2: It must have some people!
if (!d[[1]][1])
stop("Nothing to do. Empty graph.")
if (!all(s))
stop("The following adjmat are not square:\n\t",
paste0(which(!s), collapse=", "),".")
# Step 3: All must have the same dimension
e <- unlist(d, TRUE) == d[[1]][1]
if (!all(e))
stop("The dimensions of all slices must be equal. ",
"The following elements don't coincide with the first slice:\n\t",
paste0(which(!e), collapse=", "),".")
# Step 4.1: Individual's ids
ids <- rownames(graph[[1]])
if (!length(ids)) ids <- 1:d[[1]][1]
# Step 4.2 Time ids
suppressWarnings(pers <- as.integer(names(graph)))
if (!length(pers)) pers <- 1:t
else {
# Step 4.2.1: Must be coercible into integer
if (any(is.na(pers))) stop("names(graph) should be either numeric or integer.")
# Step 4.2.1: Must keep uniqueness
if (length(unique(pers)) != t) stop("When coercing names(graph) into integer,",
"some slices acquired the same name.")
}
return(invisible(list(
type="dynamic",
class="list",
ids=as.character(ids),
pers=pers,
nper=t,
n=d[[1]][1])
))
}
# Dynamic graphs (array) -----------------------------------------------------
else if (inherits(graph, "array")) {
# Step 0: it should have length!
d <- dim(graph)
if (d[3] < 2)
stop("-graph- must be at least of length 2.")
# Step 1: there must be some people
if (!d[1])
stop("Nothing to do. Empty matrix.")
# Step 2: It must be square
if (d[1] != d[2])
stop("Each adjmat in -graph- must be a square matrix\n\tdim(graph) = c(",
paste0(d, collapse=","),").")
# Step 3: Should be numeric
m <- mode(graph)
if (!(m %in% c("numeric", "integer")))
stop("-graph- should be either numeric or integer.\n\tmode(graph) = \"",
m, "\".")
# Step 4: Dimension names
ids <- rownames(graph)
if (!length(ids)) ids <- 1:d[1]
pers <- as.numeric(dimnames(graph)[[3]])
if (!length(pers)) pers <- 1:d[3]
else {
# Step 4.2.1: Must be coercible into integer
suppressWarnings(alters <- as.integer(floor(pers)))
if (any(is.na(alters))) stop("names(graph) should be either numeric or integer.")
# Step 4.2.1: Must keep uniqueness
if (length(unique(alters)) != length(pers))
stop("When coercing names(graph) into integer,",
"some slices acquired the same name.")
pers <- alters
}
return(invisible(list(
type="dynamic",
class="array",
ids=ids,
pers=pers,
nper=d[3],
n=d[1])
))
}
# Other case (ERROR) ---------------------------------------------------------
stop("Not an object allowed in netdiffuseR. It must be either:\n\t",
"matrix, dgCMatrix, list or array.\n", "Please refer to ?\"netdiffuseR-graphs\" ")
}
# Auxiliar function to check if there's any attribute of undirectedness
checkingUndirected <- function(graph, warn=TRUE, default=getOption("diffnet.undirected")) {
# Ifendifying the class of graph
if (inherits(graph, "diffnet")) undirected <- graph$meta$undirected
else undirected <- attr(graph, "undirected")
if (warn)
if (length(undirected) && undirected != FALSE)
warning("The entered -graph- will now be directed.")
if (!length(undirected)) undirected <- default
invisible(undirected)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.