#' Find node degree for epicontacts objects
#'
#' This function computes the number of contacts per cases in a
#' \code{\link{epicontacts}} dataset. Whenever contacts are directed, the
#' argument 'type' can be used to specify which kind of contact should be
#' considered: 'in' (towards the case), 'out' (from the case), or 'both'.
#'
#' @export
#'
#' @author Thibaut Jombart (\email{thibautjombart@@gmail.com})
#'
#' @param x an \code{\link{epicontacts}} object
#'
#' @param type the type of degree to be computed (see description); if contacts
#' are not directed, this will be forced to 'both'
#'
#' @param only_linelist a logical indicating if cases whose degree is computed
#' should be from the linelist exclusively
#'
#' @examples
#' ## make epicontacts object
#' if (require(outbreaks)) {
#' x <- make_epicontacts(ebola_sim$linelist, ebola_sim$contacts,
#' id="case_id", to="case_id", from="infector",
#' directed=TRUE)
#' x
#'
#' ## compute in-degree
#' deg_in <- get_degree(x)
#' table(deg_in)
#'
#' ## compute out-degree
#' deg_out <- get_degree(x, "out")
#' barplot(table(deg_out), main = "Reproduction number distribution")
#' mtext(side = 3, "(based on case out-degree)")
#'
#' }
#'
get_degree <- function(x, type = c("in", "out", "both"),
only_linelist = FALSE) {
## checks
if (!inherits(x, "epicontacts")) {
stop("x is not an 'epicontacts' object")
}
type <- match.arg(type)
what <- if (only_linelist) "linelist" else "contacts"
all_nodes <- get_id(x, which = what, na.rm = TRUE)
if (!x$directed) {
type <- "both"
}
## compute degrees
if (type=="in") {
out <- vapply(all_nodes,
function(e)
sum(e == x$contacts$to, na.rm = TRUE),
FUN.VALUE = 0L)
}
if (type=="out") {
out <- vapply(all_nodes,
function(e)
sum(e == x$contacts$from, na.rm = TRUE),
FUN.VALUE=0L)
}
if (type=="both") {
out <- vapply(all_nodes,
function(e)
sum(e == c(x$contacts$from, x$contacts$to), na.rm = TRUE),
FUN.VALUE = 0L)
}
## name, shape and return
names(out) <- all_nodes
return(out)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.