From ff5b1600fd23af04665c80b789fa2dc0993ade53 Mon Sep 17 00:00:00 2001 From: Aymeric Stamm Date: Wed, 11 Dec 2024 18:06:23 +0100 Subject: [PATCH] Add options to samplers to generate directed graphs or graphs with loops. Closes #7. --- R/samplers.R | 86 +++++++++++++++++++++++++++++++++++++++++++------ man/samplers.Rd | 29 +++++++++++++---- 2 files changed, 100 insertions(+), 15 deletions(-) diff --git a/R/samplers.R b/R/samplers.R index c861020..9eaeb92 100644 --- a/R/samplers.R +++ b/R/samplers.R @@ -5,6 +5,8 @@ #' #' @param n Sample size. #' @param num_vertices Number of vertices. +#' @param directed A boolean specifying whether to generate directed or undirected graphs. Defaults to `FALSE`. +#' @param loops A boolean specifying whether loops are authorized. Defaults to `FALSE`. #' @param lambda The mean parameter for the Poisson distribution (default: 1). #' @param rate The rate parameter for the exponential distribution (default: 1). #' @param size The number of trials for the binomial distribution (default: 1). @@ -20,59 +22,125 @@ NULL #' @rdname samplers #' @export -play_poisson <- function(num_vertices, lambda = 1) { +play_poisson <- function(num_vertices, lambda = 1, directed = FALSE, loops = FALSE) { A <- diag(0, num_vertices) A[upper.tri(A)] <- stats::rpois( n = num_vertices * (num_vertices - 1L) / 2L, lambda = lambda ) + + if (loops) { + diag(A) <- stats::rpois( + n = num_vertices, + lambda = lambda + ) + } + + if (directed) { + A[lower.tri(A)] <- stats::rpois( + n = num_vertices * (num_vertices - 1L) / 2L, + lambda = lambda + ) + return(igraph::graph_from_adjacency_matrix(A, mode = "directed", weighted = TRUE)) + } + igraph::graph_from_adjacency_matrix(A, mode = "upper", weighted = TRUE) } #' @rdname samplers #' @export -rpois_network <- function(n, num_vertices, lambda = 1) { +rpois_network <- function(n, num_vertices, lambda = 1, directed = FALSE, loops = FALSE) { as_nvd(replicate(n, { - play_poisson(num_vertices = num_vertices, lambda = lambda) + play_poisson( + num_vertices = num_vertices, + lambda = lambda, + directed = directed, + loops = loops + ) }, simplify = FALSE)) } #' @rdname samplers #' @export -play_exponential <- function(num_vertices, rate = 1) { +play_exponential <- function(num_vertices, rate = 1, directed = FALSE, loops = FALSE) { A <- diag(0, num_vertices) A[upper.tri(A)] <- stats::rexp( n = num_vertices * (num_vertices - 1L) / 2L, rate = rate ) + + if (loops) { + diag(A) <- stats::rexp( + n = num_vertices, + rate = rate + ) + } + + if (directed) { + A[lower.tri(A)] <- stats::rexp( + n = num_vertices * (num_vertices - 1L) / 2L, + rate = rate + ) + return(igraph::graph_from_adjacency_matrix(A, mode = "directed", weighted = TRUE)) + } + igraph::graph_from_adjacency_matrix(A, mode = "upper", weighted = TRUE) } #' @rdname samplers #' @export -rexp_network <- function(n, num_vertices, rate = 1) { +rexp_network <- function(n, num_vertices, rate = 1, directed = FALSE, loops = FALSE) { as_nvd(replicate(n, { - play_exponential(num_vertices = num_vertices, rate = rate) + play_exponential( + num_vertices = num_vertices, + rate = rate, + directed = directed, + loops = loops + ) }, simplify = FALSE)) } #' @rdname samplers #' @export -play_binomial <- function(num_vertices, size = 1, prob = 0.5) { +play_binomial <- function(num_vertices, size = 1, prob = 0.5, directed = FALSE, loops = FALSE) { A <- diag(0, num_vertices) A[upper.tri(A)] <- stats::rbinom( n = num_vertices * (num_vertices - 1L) / 2L, size = size, prob = prob ) + + if (loops) { + diag(A) <- stats::rbinom( + n = num_vertices, + size = size, + prob = prob + ) + } + + if (directed) { + A[lower.tri(A)] <- stats::rbinom( + n = num_vertices * (num_vertices - 1L) / 2L, + size = size, + prob = prob + ) + return(igraph::graph_from_adjacency_matrix(A, mode = "directed", weighted = TRUE)) + } + igraph::graph_from_adjacency_matrix(A, mode = "upper", weighted = TRUE) } #' @rdname samplers #' @export -rbinom_network <- function(n, num_vertices, size = 1, prob = 0.5) { +rbinom_network <- function(n, num_vertices, size = 1, prob = 0.5, directed = FALSE, loops = FALSE) { as_nvd(replicate(n, { - play_binomial(num_vertices = num_vertices, size = size, prob = prob) + play_binomial( + num_vertices = num_vertices, + size = size, + prob = prob, + directed = directed, + loops = loops + ) }, simplify = FALSE)) } diff --git a/man/samplers.Rd b/man/samplers.Rd index 4ecd30f..fe1139d 100644 --- a/man/samplers.Rd +++ b/man/samplers.Rd @@ -10,23 +10,40 @@ \alias{rbinom_network} \title{Graph samplers using edge distributions} \usage{ -play_poisson(num_vertices, lambda = 1) +play_poisson(num_vertices, lambda = 1, directed = FALSE, loops = FALSE) -rpois_network(n, num_vertices, lambda = 1) +rpois_network(n, num_vertices, lambda = 1, directed = FALSE, loops = FALSE) -play_exponential(num_vertices, rate = 1) +play_exponential(num_vertices, rate = 1, directed = FALSE, loops = FALSE) -rexp_network(n, num_vertices, rate = 1) +rexp_network(n, num_vertices, rate = 1, directed = FALSE, loops = FALSE) -play_binomial(num_vertices, size = 1, prob = 0.5) +play_binomial( + num_vertices, + size = 1, + prob = 0.5, + directed = FALSE, + loops = FALSE +) -rbinom_network(n, num_vertices, size = 1, prob = 0.5) +rbinom_network( + n, + num_vertices, + size = 1, + prob = 0.5, + directed = FALSE, + loops = FALSE +) } \arguments{ \item{num_vertices}{Number of vertices.} \item{lambda}{The mean parameter for the Poisson distribution (default: 1).} +\item{directed}{A boolean specifying whether to generate directed or undirected graphs. Defaults to \code{FALSE}.} + +\item{loops}{A boolean specifying whether loops are authorized. Defaults to \code{FALSE}.} + \item{n}{Sample size.} \item{rate}{The rate parameter for the exponential distribution (default: 1).}