Epidemiological metrics for netdiffuseR

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: netdiffuseR
 Title: Analysis of Diffusion and Contagion Processes on Networks
-Version: 1.25.0
+Version: 1.26.0
 Authors@R: c(
   person("George", "Vega Yon", email="g.vegayon@gmail.com", role=c("aut", "cre"),
     comment=c(ORCID = "0000-0002-3171-0844", what="Rewrite functions with Rcpp, plus new features")
@@ -57,11 +57,13 @@ URL: https://github.com/USCCANA/netdiffuseR,
  https://USCCANA.github.io/netdiffuseR/
 BugReports: https://github.com/USCCANA/netdiffuseR/issues
 Classification/MSC: 90C35, 90B18, 91D30
-Collate: 
+Collate:
     'RcppExports.R'
     'imports.r'
     'graph_data.r'
     'adjmat.r'
+    'adoption_mechanisms.R'
+    'disadoption_mechanisms.R'
     'bass.r'
     'bootnet.r'
     'citer_environment.R'
@@ -94,3 +96,4 @@ Collate:
     'struct_equiv.R'
     'struct_test.R'
     'survey_to_diffnet.R'
+    'transmission.R'

NAMESPACE

@@ -85,12 +85,16 @@ export("diffnet.attrs<-")
 export("diffnet.toa<-")
 export(adjmat_to_edgelist)
 export(adopt_changes)
+export(adoptmech_logit)
+export(adoptmech_probit)
+export(adoptmech_threshold)
 export(approx_geodesic)
 export(approx_geodist)
 export(as.dgCMatrix)
 export(as_dgCMatrix)
 export(as_diffnet)
 export(as_spmat)
+export(as_transmission_tree)
 export(bass_F)
 export(bass_dF)
 export(bass_f)
@@ -114,6 +118,10 @@ export(diffnet_to_network)
 export(diffnet_to_networkDynamic)
 export(diffreg)
 export(diffusionMap)
+export(disadoptmech_bithreshold)
+export(disadoptmech_logit)
+export(disadoptmech_probit)
+export(disadoptmech_random)
 export(drawColorKey)
 export(drop_isolated)
 export(edgelist_to_adjmat)
@@ -186,6 +194,7 @@ export(threshold)
 export(toa_diff)
 export(toa_mat)
 export(transformGraphBy)
+export(transmission_tree)
 export(vertex_covariate_compare)
 export(vertex_covariate_dist)
 export(vertex_mahalanobis_dist)

NEWS.md

@@ -11,6 +11,9 @@
 * New dataset `epigames` and `epigamesDiffNet`: a simulated epidemic game
   network with 594 nodes and 15 time periods from the WKU Epi Games study.
 
+* `exposure()` and `rdiffnet()` now support `mode = "stochastic"`, allowing
+  for probabilistic interpretation of edge weights in exposure calculations.
+
 ## Internal changes
 
 * Fixed CRAN example error in `round_to_seq()`: `plot(w, x)` replaced with
@@ -19,7 +22,6 @@
 
 * Removed `configure` framework. R already provides paths and configuration for OpenMP.
 
-
 # Changes in netdiffuseR version 1.24.0 (2025-12-09)
 
 * New function `degree_adoption_diagnostic()` analyzes the correlation between network 

R/adjmat.r

@@ -537,6 +537,29 @@ toa_mat.default <- function(per, t0, t1) {
   )
 }
 
+# Build (adopt, cumadopt) from (toa, tod) intervals for a single behavior.
+# Each node i is considered adopted on periods [toa[i], tod[i] - 1]; when
+# tod[i] is NA the adoption is absorbing and the interval runs through t1.
+cumadopt_from_intervals <- function(toa, tod, t0, t1, labels = NULL) {
+  n <- length(toa)
+  T <- t1 - t0 + 1L
+  adopt    <- matrix(0L, nrow = n, ncol = T)
+  cumadopt <- matrix(0L, nrow = n, ncol = T)
+  for (i in seq_len(n)) {
+    s_val <- toa[i]
+    if (is.na(s_val)) next
+    s <- as.integer(s_val) - t0 + 1L
+    e_val <- tod[i]
+    e <- if (is.na(e_val)) T else (as.integer(e_val) - 1L - t0 + 1L)
+    if (s >= 1L && s <= T) adopt[i, s] <- 1L
+    if (s <= e && s >= 1L && e <= T && e >= 1L) cumadopt[i, s:e] <- 1L
+  }
+  rn <- if (length(labels)) labels else seq_len(n)
+  dimnames(adopt)    <- list(rn, t0:t1)
+  dimnames(cumadopt) <- list(rn, t0:t1)
+  list(adopt = adopt, cumadopt = cumadopt)
+}
+
 # @rdname toa_mat
 # @export
 toa_mat.numeric <- function(times, labels=NULL,

R/adoption_mechanisms.R

@@ -0,0 +1,79 @@
+#' Adoption mechanisms for \code{rdiffnet}
+#'
+#' A family of pluggable kernels that decide which nodes adopt at each
+#' simulation step. Pass any of these as the \code{adoption_mechanism}
+#' argument of \code{\link{rdiffnet}}, or write your own function that
+#' follows the same contract.
+#'
+#' @param expo Numeric vector of length \eqn{n}. Per-node exposure at
+#'   the current time step (\code{expo[, , q]} for behaviour \eqn{q}).
+#' @param thresholds Numeric vector of length \eqn{n}. Per-node adoption
+#'   threshold (\code{thr[, q]}). Used by the deterministic kernel;
+#'   passed but ignored by the stochastic kernels so user-defined
+#'   mechanisms can choose whether to use it.
+#' @param not_adopted Logical vector of length \eqn{n}. \code{TRUE} for
+#'   nodes that have not yet adopted behaviour \eqn{q}
+#'   (\code{is.na(toa[, q])}).
+#' @param time Integer scalar. Current simulation time step.
+#' @param pars Named list of mechanism-specific parameters. Each
+#'   kernel documents which fields it expects.
+#'
+#' @return Integer vector of node indices that adopt at this step.
+#'
+#' @details
+#' The contract is intentionally minimal so that any user can write a
+#' mechanism without reading the package internals: receive the current
+#' state, decide who adopts, return the indices. The three kernels
+#' below cover the common cases.
+#'
+#' \describe{
+#'  \item{\code{adoptmech_threshold}}{Tom Valente's deterministic
+#'    threshold rule. Adopt iff \code{expo[i] >= thresholds[i]}.
+#'    Ignores \code{pars}.}
+#'  \item{\code{adoptmech_logit}}{Bernoulli rule with logit link.
+#'    Adopt with probability \code{plogis(beta0 + beta_expo * expo[i])}.
+#'    Requires \code{pars$beta0} and \code{pars$beta_expo}.}
+#'  \item{\code{adoptmech_probit}}{Bernoulli rule with probit link.
+#'    Adopt with probability \code{pnorm(beta0 + beta_expo * expo[i])}.
+#'    Requires \code{pars$beta0} and \code{pars$beta_expo}.}
+#' }
+#'
+#' @examples
+#' set.seed(2026)
+#'
+#' # Default deterministic threshold
+#' dn <- rdiffnet(n = 30, t = 6, seed.graph = "small-world",
+#'                seed.p.adopt = 0.1, stop.no.diff = FALSE)
+#'
+#' # Stochastic logit mechanism
+#' dn <- rdiffnet(n = 30, t = 6, seed.graph = "small-world",
+#'                seed.p.adopt = 0.1, stop.no.diff = FALSE,
+#'                adoption_mechanism = adoptmech_logit,
+#'                adoption_pars      = list(beta0 = -2, beta_expo = 5))
+#'
+#' @name adoption_mechanisms
+NULL
+
+#' @rdname adoption_mechanisms
+#' @export
+adoptmech_threshold <- function(expo, thresholds, not_adopted, time, pars) {
+  which((expo >= thresholds) & not_adopted)
+}
+
+#' @rdname adoption_mechanisms
+#' @export
+adoptmech_logit <- function(expo, thresholds, not_adopted, time, pars) {
+  if (is.null(pars$beta0) || is.null(pars$beta_expo))
+    stop("-adoptmech_logit- requires -adoption_pars- with both -beta0- and -beta_expo-.")
+  p <- stats::plogis(pars$beta0 + pars$beta_expo * expo)
+  which((stats::runif(length(p)) < p) & not_adopted)
+}
+
+#' @rdname adoption_mechanisms
+#' @export
+adoptmech_probit <- function(expo, thresholds, not_adopted, time, pars) {
+  if (is.null(pars$beta0) || is.null(pars$beta_expo))
+    stop("-adoptmech_probit- requires -adoption_pars- with both -beta0- and -beta_expo-.")
+  p <- stats::pnorm(pars$beta0 + pars$beta_expo * expo)
+  which((stats::runif(length(p)) < p) & not_adopted)
+}

R/data.r

@@ -980,6 +980,21 @@ NULL # "epigames"
 #' A directed dynamic graph with 594 vertices and 15 time periods. The attributes
 #' in the graph are described in \code{\link{epigames}}.
 #'
+#' By default, this \code{diffnet} object is **non-cumulative** (each slice represents 
+#' ephemeral daily contacts) and **valued** (edge weights represent contact duration in seconds). 
+#' 
+#' To reconstruct the classic cumulative/binarized network, you can run:
+#' 
+#' \preformatted{
+#' epigames_cumul <- epigamesDiffNet
+#' 
+#' # 1. Accumulate the history across time periods
+#' epigames_cumul$graph <- Reduce("+", epigames_cumul$graph, accumulate = TRUE)
+#' 
+#' # 2. Apply a logical cut-off to binarize the network
+#' epigames_cumul$graph <- lapply(epigames_cumul$graph, function(m) { m@x[] <- 1; m })
+#' }
+#'
 #' Non-adopters have \code{toa = NA}.
 #'
 #' @format A \code{\link{diffnet}} class object.