v1.5.5

.github/workflows/pushrelease.yml

@@ -76,7 +76,7 @@ jobs:
       contents: write
     steps:
       - name: Checkout one
-        uses: actions/checkout@master
+        uses: actions/checkout@v4
         with:
           fetch-depth: '0'
       - name: Bump version and push tag

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: migraph
 Title: Inferential Methods for Multimodal and Other Networks 
-Version: 1.5.4
-Date: 2025-11-05
+Version: 1.5.5
+Date: 2025-11-12
 Description: A set of tools for testing networks.
    It includes functions for univariate and multivariate 
    conditional uniform graph and quadratic assignment procedure testing,
@@ -25,6 +25,7 @@ Depends:
     autograph (>= 0.4.0)
 Imports: 
     dplyr (>= 1.1.0),
+    ergm,
     future,
     furrr,
     generics,

NAMESPACE

@@ -1,13 +1,18 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(glance,ergm)
 S3method(glance,netlm)
 S3method(glance,netlogit)
+S3method(predict,netlm)
+S3method(predict,netlogit)
 S3method(print,diffs_model)
+S3method(print,ergm)
 S3method(print,netlm)
 S3method(print,netlogit)
 S3method(print,network_test)
 S3method(print,over_memb)
 S3method(summary,diffs_model)
+S3method(tidy,ergm)
 S3method(tidy,netlm)
 S3method(tidy,netlogit)
 export("%>%")
@@ -29,6 +34,7 @@ importFrom(autograph,ag_base)
 importFrom(dplyr,`%>%`)
 importFrom(dplyr,bind_cols)
 importFrom(dplyr,left_join)
+importFrom(ergm,as.rlebdm)
 importFrom(furrr,furrr_options)
 importFrom(furrr,future_map_dfr)
 importFrom(future,plan)

NEWS.md

@@ -1,3 +1,16 @@
+# migraph 1.5.5
+
+2025-11-12
+
+## Modelling
+
+- Added `tidy()` and `glance()` methods for `ergm` objects
+- Added `predict()` methods for `netlm` and `netlogit` objects
+
+## Tutorials
+
+- Added ergm tutorial
+
 # migraph 1.5.4
 
 2025-11-05

R/class_models.R

@@ -47,6 +47,57 @@ tidy.netlogit <- function(x, conf.int = FALSE, conf.level = 0.95,
   result
 }
 
+#' @method tidy ergm
+#' @importFrom stats quantile
+#' @export
+tidy.ergm <- function(
+    x,
+    conf.int = FALSE,
+    conf.level = 0.95,
+    exponentiate = FALSE,
+    ...
+) {
+  # in ergm 3.9 summary(x, ...)$coefs has columns:
+  #   Estimate, Std. Error, MCMC %, Pr(>|Z|)
+
+  # in ergm 3.10 summary(x, ...)$coefs has columns:
+  #   Estimate, Std. Error, MCMC %, z value, Pr(>|Z|)
+
+  ret <- summary(x, ...)$coefficients %>%
+    dplyr::as_tibble(rownames = "term") %>%
+    rename2(
+      term = "term",
+      estimate = "Estimate",
+      std.error = "Std. Error",
+      mcmc.error = "MCMC %",
+      statistic = "z value",
+      p.value = "Pr(>|z|)"
+    )
+
+  if (conf.int) {
+    z <- stats::qnorm(1 - (1 - conf.level) / 2)
+    ret$conf.low <- ret$estimate - z * ret$std.error
+    ret$conf.high <- ret$estimate + z * ret$std.error
+  }
+
+  if (exponentiate) {
+    if (
+      is.null(x$glm) ||
+      (x$glm$family$link != "logit" && x$glm$family$link != "log")
+    ) {
+      manynet::snet_warn(
+        "Coefficients will be exponentiated, but the model didn't 
+         use a {.code log} or {.code logit} link."
+      )
+    }
+
+    ret <- exponentiate(ret)
+  }
+
+  dplyr::as_tibble(ret)
+}
+
+
 #' @importFrom generics glance
 #' @export
 generics::glance
@@ -132,6 +183,62 @@ glance.netlogit <- function(x, ...) {
   )
 }
 
+
+#' @method glance ergm
+#' @importFrom ergm as.rlebdm
+#' @export
+glance.ergm <- function(x, deviance = FALSE, mcmc = FALSE, ...) {
+  s <- summary(x, ...) # produces lots of messages
+
+  ret <- dplyr::tibble(
+    independence = s$independence,
+    iterations = x$iterations,
+    logLik = as.numeric(stats::logLik(x))
+  )
+
+  if (deviance & !is.null(ret$logLik)) {
+    # see #567 for details on the following
+
+    thisRequires("ergm")
+
+    if (utils::packageVersion("ergm") < "3.10") {
+      dyads <- sum(
+        ergm::as.rlebdm(x$constrained, x$constrained.obs, which = "informative")
+      )
+    } else {
+      dyads <- stats::nobs(x)
+    }
+
+    lln <- ergm::logLikNull(x)
+    ret$null.deviance <- if (is.na(lln)) 0 else -2 * lln
+    ret$df.null <- dyads
+
+    ret$residual.deviance <- -2 * ret$logLik
+    ret$df.residual <- dyads - length(x$coefs)
+  }
+
+  ret$AIC <- stats::AIC(x)
+  ret$BIC <- stats::BIC(x)
+
+  if (mcmc) {
+    if (isTRUE(x$MPLE_is_MLE)) {
+      manynet::snet_info(
+        c(
+          "Though {.fn glance} was supplied {.code mcmc = TRUE}, the model was not
+           fitted using MCMC,",
+          "i" = "The corresponding columns will be omitted."
+        )
+      )
+    }
+
+    ret$MCMC.interval <- x$control$MCMC.interval
+    ret$MCMC.burnin <- x$control$MCMC.burnin
+    ret$MCMC.samplesize <- x$control$MCMC.samplesize
+  }
+
+  ret
+}
+
 #' @export
 print.netlm <- function(x, ...){
   cat("# Fitted model results\n")
@@ -147,3 +254,30 @@ print.netlogit <- function(x, ...){
   cat("\n# Model summary statistics\n")
   print(glance(x))
 }
+
+#' @export
+print.ergm <- function(x, ...){
+  cat("# Fitted model results\n")
+  print(tidy(x))
+  cat("\n# Model summary statistics\n")
+  print(glance(x))
+}
+
+
+# Utilities from broom ####
+
+rename2 <- function(.data, ...) {
+  dots <- dplyr::quos(...)
+  present <- purrr::keep(dots, ~ dplyr::quo_name(.x) %in% colnames(.data))
+  dplyr::rename(.data, !!!present)
+}
+
+exponentiate <- function(data, col = "estimate") {
+  data <- data %>% dplyr::mutate(dplyr::across(dplyr::all_of(col), exp))
+
+  if ("conf.low" %in% colnames(data)) {
+    data <- data %>% dplyr::mutate(dplyr::across(c(conf.low, conf.high), exp))
+  }
+
+  data
+}

R/migraph-package.R

@@ -20,7 +20,7 @@ thisRequires <- function(pkgname){
 }
 
 # defining global variables more centrally
-utils::globalVariables(c(".data", "obs", "fin","n","sim","time","value"))
+utils::globalVariables(c(".data", "obs", "fin","n","sim","time","value","conf.low","conf.high"))
 
 # Suppress R CMD check note
 # Namespace in Imports field not imported from: PKG

R/model_predict.R

@@ -0,0 +1,79 @@
+#' Predict methods for network regression
+#' @param object An object of class inheriting "netlm" or "netlogit"
+#' @param newdata A design matrix with the same columns/variables as the
+#'   fitted model.
+#' @param ... Additional arguments (not used).
+#' @return A numeric vector of predicted values.
+#' @name predict
+NULL
+
+#' @rdname predict
+#' @method predict netlm
+#' @examples
+#' networkers <- ison_networkers %>% to_subgraph(Discipline == "Sociology")
+#' model1 <- net_regression(weight ~ ego(Citations) + alter(Citations) + sim(Citations), 
+#'                       networkers, times = 20)
+#' predict(model1, matrix(c(1,10,5,2),1,4))
+#' @export
+predict.netlm <- function(object, newdata = NULL, ...) {
+  # Extract coefficients
+  coefs <- stats::coef(object)
+
+  # If no newdata provided, use the original design matrix
+  if (is.null(newdata)) {
+    if (!is.null(object$X)) {
+      newdata <- object$X
+    } else {
+      stop("No newdata provided and original design matrix not found in object.")
+    }
+  }
+
+  # Ensure newdata is a matrix
+  newdata <- as.matrix(newdata)
+
+  # Compute predictions
+  preds <- newdata %*% coefs
+
+  return(drop(preds))
+}
+
+#' @rdname predict
+#' @method predict netlogit
+#' @param type Character string, one of "response" 
+#'   (default, whether the returned predictions are on the probability scale) 
+#'   or "link" (returned predictions are on the scale of the linear predictor).
+#' @examples
+#' networkers <- ison_networkers %>% to_subgraph(Discipline == "Sociology") %>% 
+#'   to_unweighted()
+#' model1 <- net_regression(. ~ ego(Citations) + alter(Citations) + sim(Citations), 
+#'                       networkers, times = 20)
+#' predict(model1, matrix(c(1,10,5,2),1,4))
+#' @export
+predict.netlogit <- function(object, newdata = NULL, type = c("link", "response"), ...) {
+  type <- match.arg(type)
+
+  # Extract coefficients
+  coefs <- stats::coef(object)
+
+  # If no newdata provided, use the original design matrix
+  if (is.null(newdata)) {
+    if (!is.null(object$X)) {
+      newdata <- object$X
+    } else {
+      stop("No newdata provided and original design matrix not found in object.")
+    }
+  }
+
+  # Ensure newdata is a matrix
+  newdata <- as.matrix(newdata)
+
+  # Compute linear predictor
+  eta <- newdata %*% coefs
+
+  # Return either linear predictor or probability
+  if (type == "link") {
+    return(drop(eta))
+  } else {
+    return(drop(1 / (1 + exp(-eta))))
+  }
+}