# R/threshold.graph.R In netrankr: Analyzing Partial Rankings in Networks

#### Documented in threshold_graph

```#' @title Random threshold graphs
#' @description  Constructs a random threshold graph.
#' A threshold graph is a graph where the neighborhood inclusion preorder is complete.
#' @param n The number of vertices in the graph.
#' @param p The probability of inserting dominating vertices. Equates approximately
#'     to the density of the graph. See Details.
#' @param bseq (0,1)-vector a binary sequence that produces a threshold grah. See details
#' @details Either `n` and `p`, or `bseq` must be specified.
#' Threshold graphs can be constructed with a binary sequence. For each 0, an isolated
#' vertex is inserted and for each 1, a vertex is inserted that connects to all previously inserted
#' vertices. The probability of inserting a dominating vertices is controlled with parameter `p`.
#' If `bseq` is given instead, a threshold graph is constructed from that sequence.
#' An important property of threshold graphs is, that all centrality indices induce the same ranking.
#' @return A threshold graph as igraph object
#' @author David Schoch
#' @references Mahadev, N. and Peled, U. N. , 1995. Threshold graphs and related topics.
#'
#' Schoch, D., Valente, T. W. and Brandes, U., 2017. Correlations among centrality
#' indices and a class of uniquely ranked graphs. *Social Networks* 50, 46–54.
#'
#' @seealso [neighborhood_inclusion], [positional_dominance]
#' @examples
#' library(igraph)
#' g <- threshold_graph(10, 0.3)
#' \dontrun{
#' plot(g)
#'
#' # star graphs and complete graphs are threshold graphs
#' complete <- threshold_graph(10, 1) # complete graph
#' plot(complete)
#'
#' star <- threshold_graph(10, 0) # star graph
#' plot(star)
#' }
#'
#' # centrality scores are perfectly rank correlated
#' cor(degree(g), closeness(g), method = "kendall")
#' @export
threshold_graph <- function(n, p, bseq) {
if (missing(n) & missing(bseq)) {
stop("Either specify both n and p, or bseq ")
}
if (missing(p) & missing(bseq)) {
stop("Either specify both n and p, or bseq ")
}

if (!missing(n) & !missing(p)) {
vschedule <- rep(0, n)
pvals <- stats::runif(n)

vschedule[pvals <= p] <- 1
vschedule[n] <- 1
vschedule[1] <- 0
} else if (!missing(bseq)) {
n <- length(bseq)
if (bseq[n] == 0) {
warning("bseq[n]=0 produces unconnected graphs. using bseq[n]=1 instead")
bseq[n] <- 1
}
vschedule <- bseq
vschedule[1] <- 0
}
dom_vertices <- which(vschedule == 1)
if (length(dom_vertices) != 1) {
edgelist <- do.call(rbind, sapply(dom_vertices, function(v) cbind(rep(v, (v - 1)), seq(1, (v - 1)))))
} else {
edgelist <- cbind(rep(n, (n - 1)), seq(1, (n - 1)))
}
g <- igraph::graph_from_edgelist(edgelist, directed = FALSE)
g\$sequence <- vschedule
return(g)
}
```

## Try the netrankr package in your browser

Any scripts or data that you put into this service are public.

netrankr documentation built on Sept. 27, 2022, 1:07 a.m.