v1.6.8

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: migraph
 Title: Inferential Methods for Multimodal and Other Networks 
-Version: 1.6.7
+Version: 1.6.8
 Description: A set of tools for testing networks.
    It includes functions for univariate and multivariate conditional uniform graph 
    and quadratic assignment procedure testing, and network regression.

NAMESPACE

@@ -34,9 +34,7 @@ export(test_permutation)
 export(test_random)
 export(tidy)
 importFrom(autograph,ag_base)
-importFrom(dplyr,"%>%")
 importFrom(dplyr,as_tibble)
-importFrom(dplyr,bind_cols)
 importFrom(dplyr,left_join)
 importFrom(dplyr,select)
 importFrom(dplyr,tibble)

NEWS.md

@@ -1,3 +1,21 @@
+# migraph 1.6.8
+
+2026-07-31
+
+## Package
+
+- Replaced all remaining uses of the magrittr pipe `%>%` with the native pipe `|>`, in package code, tests, examples, and tutorials
+  - This fixes the `predict()`, `net_regression()`, and `test_*()` examples, which still called `%>%` after the re-export was removed in 1.6.3 and so were relying on `{dplyr}` being attached
+  - `%>%` is no longer imported from `{dplyr}`
+  - The pipes section of tutorial0 now teaches `|>` only, noting `%>%` as something readers may encounter in older code
+
+## Models
+
+- Substantially accelerated `net_regression()` (by about 35x), resolving the CRAN NOTE about the running time of the `predict()` examples
+  - Permutations now operate directly on the matrices rather than coercing to and from a network object each time, deferring to `manynet::to_permuted()` again once manynet gains a method for matrix input
+  - Vectorising the matrix list for each fit now uses base operations rather than constructing a data frame
+  - Results are unchanged: for a given seed, the same permutations are drawn and the same coefficients, test statistics, and p-values are returned
+
 # migraph 1.6.7
 
 2026-07-31

R/class_makes.R

@@ -1,6 +1,6 @@
 make_network_measures <- function(out, .data) {
-  out <- dplyr::as_tibble(out) %>% 
-    dplyr::mutate(time = as.numeric(names(out))) %>% 
+  out <- dplyr::as_tibble(out) |> 
+    dplyr::mutate(time = as.numeric(names(out))) |> 
     dplyr::select(time, value)
   class(out) <- c("network_measures", class(out))
   attr(out, "mode") <- manynet::net_dims(.data)
@@ -15,8 +15,8 @@ make_diffs_model <- function(report, .data) {
 
 #' @export
 summary.diffs_model <- function(object, ...) {
-  object %>% dplyr::mutate(fin = (I!=n)*1) %>% 
-    dplyr::group_by(sim) %>% dplyr::summarise(toa = sum(fin)+1)
+  object |> dplyr::mutate(fin = (I!=n)*1) |> 
+    dplyr::group_by(sim) |> dplyr::summarise(toa = sum(fin)+1)
 }
 
 #' @export

R/class_models.R

@@ -63,8 +63,8 @@ tidy.ergm <- function(
   # 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") %>%
+  ret <- summary(x, ...)$coefficients |>
+    dplyr::as_tibble(rownames = "term") |>
     rename2(
       term = "term",
       estimate = "Estimate",
@@ -305,10 +305,10 @@ rename2 <- function(.data, ...) {
 }
 
 exponentiate <- function(data, col = "estimate") {
-  data <- data %>% dplyr::mutate(dplyr::across(dplyr::all_of(col), exp))
+  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 <- data |> dplyr::mutate(dplyr::across(c(conf.low, conf.high), exp))
   }
 
   data

R/model_distrib.R

@@ -59,7 +59,7 @@ test_fit <- function(diff_model, diff_models){ # make into method?
   x <- diff_model
   if(manynet::is_graph(x)) x <- manynet::as_diffusion(x)
   y <- diff_models
-  sims <- y %>% dplyr::select(sim, t, I)
+  sims <- y |> dplyr::select(sim, t, I)
   if(max(x$t) < max(sims$t)){
     x <- dplyr::mutate(x, t = as.integer(t), S = as.integer(S), I = as.integer(I)) |> 
       dplyr::select(t, S, I)

R/model_predict.R

@@ -10,9 +10,10 @@ 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 <- ison_networkers |> to_subgraph(Discipline == "Sociology")
+#' model1 <- net_regression(weight ~ ego(Citations) + alter(Citations) + sim(Citations),
 #'                       networkers, times = 20)
+#' # Should be run many more `times` for publication-ready results
 #' predict(model1, matrix(c(1,10,5,2),1,4))
 #' @export
 predict.netlm <- function(object, newdata = NULL, ...) {
@@ -43,10 +44,11 @@ predict.netlm <- function(object, newdata = NULL, ...) {
 #'   (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") %>% 
+#' networkers <- ison_networkers |> to_subgraph(Discipline == "Sociology") |> 
 #'   to_unweighted()
-#' model1 <- net_regression(. ~ ego(Citations) + alter(Citations) + sim(Citations), 
+#' model1 <- net_regression(. ~ ego(Citations) + alter(Citations) + sim(Citations),
 #'                       networkers, times = 20)
+#' # Should be run many more `times` for publication-ready results
 #' predict(model1, matrix(c(1,10,5,2),1,4))
 #' @export
 predict.netlogit <- function(object, newdata = NULL, type = c("link", "response"), ...) {

R/model_regression.R

@@ -68,7 +68,7 @@
 #' @param verbose Whether the function should report on its progress.
 #'   By default FALSE.
 #'   See [`{progressr}`](https://progressr.futureverse.org) for more.
-#' @importFrom dplyr bind_cols left_join
+#' @importFrom dplyr left_join
 #' @importFrom purrr flatten
 #' @importFrom future plan
 #' @importFrom furrr future_map_dfr furrr_options
@@ -85,7 +85,7 @@
 #'   \doi{10.1007/s11336-007-9016-1}.
 #'   
 #' @examples
-#' networkers <- ison_networkers %>% to_subgraph(Discipline == "Sociology")
+#' networkers <- ison_networkers |> to_subgraph(Discipline == "Sociology")
 #' model1 <- net_regression(weight ~ ego(Citations) + alter(Citations) + sim(Citations), 
 #'                       networkers, times = 20)
 #' # Should be run many more `times` for publication-ready results
@@ -171,14 +171,14 @@ net_regression <- function(formula, .data,
   on.exit(future::plan(oplan), add = TRUE)
     if(valued){
       repdist <- furrr::future_map_dfr(1:times, function(j){
-        nlmfit(c(list(manynet::to_permuted(g[[1]], with_attr = FALSE)),
+        nlmfit(c(list(permute_matrix(g[[1]])),
                  g[2:(nx+1)]),
                directed = directed, diag = diag,
                rety = FALSE)
       }, .progress = verbose, .options = furrr::furrr_options(seed = T))
     } else {
       repdist <- furrr::future_map_dfr(1:times, function(j){
-        repfit <- nlgfit(c(list(manynet::to_permuted(g[[1]], with_attr = FALSE)),
+        repfit <- nlgfit(c(list(permute_matrix(g[[1]])),
                            g[2:(nx+1)]),
                          directed = directed, diag = diag)
         repfit$coef/sqrt(diag(chol2inv(repfit$qr$qr)))
@@ -207,14 +207,14 @@ net_regression <- function(formula, .data,
       if(valued){
         repdist[,i] <- furrr::future_map_dbl(1:times, function(j){
           nlmfit(c(g[-(1 + i)],
-                   list(manynet::to_permuted(xres, with_attr = FALSE))),
+                   list(permute_matrix(xres))),
                  directed = directed, diag = diag,
                  rety = FALSE)[nx]
         }, .progress = verbose, .options = furrr::furrr_options(seed = T))
       } else {
         repdist[,i] <- furrr::future_map_dbl(1:times, function(j){
           repfit <- nlgfit(c(g[-(1 + i)],
-                             list(manynet::to_permuted(xres, with_attr = FALSE))),
+                             list(permute_matrix(xres))),
                            directed = directed, diag = diag)
           repfit$coef[nx]/sqrt(diag(chol2inv(repfit$qr$qr)))[nx]
         }, .progress = verbose, .options = furrr::furrr_options(seed = T))
@@ -283,10 +283,48 @@ vectorise_list <- function(glist, simplex, directed){
     diag(glist[[1]]) <- NA
   if(!directed)
     glist[[1]][upper.tri(glist[[1]])] <- NA
-  suppressMessages(stats::na.omit(dplyr::bind_cols(furrr::future_map(glist, 
-                                                       function(x) c(x)))))
+  # Assembled with base operations rather than a data frame because this is
+  # called once per permutation, so per-call overhead dominates the QR itself
+  out <- matrix(unlist(lapply(glist, as.vector), use.names = FALSE),
+                ncol = length(glist),
+                dimnames = list(NULL, names(glist)))
+  out[stats::complete.cases(out), , drop = FALSE]
 }
 
+# Permutes a matrix as `manynet::to_permuted()` would, but without the
+# round-trip coercion to a network object, which dominates the permutation
+# loops below. Rows and columns are permuted together for one-mode networks
+# and independently for two-mode ones; labels stay put while values move.
+# Once manynet gains a `to_permuted()` method for matrix input this shortcut
+# is redundant, and we defer to it again.
+permute_matrix <- function(m){
+  if(manynet_permutes_matrices())
+    manynet::to_permuted(m, with_attr = FALSE)
+  else permute_matrix_directly(m)
+}
+
+permute_matrix_directly <- function(m){
+  rows <- sample(seq_len(dim(m)[1]))
+  cols <- if(manynet::is_twomode(m)) sample(seq_len(dim(m)[2])) else rows
+  matrix(m[rows, cols], nrow = dim(m)[1], ncol = dim(m)[2],
+         dimnames = if(manynet::is_labelled(m)) dimnames(m) else NULL)
+}
+
+# Detects the matrix method rather than a manynet version, so that a release
+# without it keeps the shortcut instead of silently reverting to the slow
+# coercion path. Cached because `permute_matrix()` is called once per
+# permutation, and looking the method up each time would reintroduce the
+# per-call overhead the shortcut exists to avoid.
+manynet_permutes_matrices <- local({
+  delegate <- NA
+  function(){
+    if(is.na(delegate))
+      delegate <<- !is.null(utils::getS3method("to_permuted", "matrix",
+                                               optional = TRUE))
+    delegate
+  }
+})
+
 convertToMatrixList <- function(formula, .data){
   data <- manynet::as_tidygraph(.data)
   if(manynet::is_weighted(data) & getDependentName(formula)=="weight"){

R/model_tests.R

@@ -23,8 +23,8 @@ NULL
 #' @rdname tests 
 #' @importFrom manynet generate_random bind_node_attributes is_directed is_complex
 #' @examples 
-#' marvel_friends <- fict_marvel %>% to_uniplex("relationship") %>% 
-#'   to_unsigned() %>% to_giant() %>% 
+#' marvel_friends <- fict_marvel |> to_uniplex("relationship") |> 
+#'   to_unsigned() |> to_giant() |> 
 #'   to_subgraph(PowerOrigin == "Human")
 #' (cugtest <- test_random(marvel_friends, net_by_heterophily, attribute = "Attractive",
 #'    times = 200))

R/tutorial_run.R

@@ -14,7 +14,7 @@
 #'   saving the .R script to the current working directory.
 #'   
 #' @param tute String, name of the tutorial (e.g. "tutorial2").
-#' @importFrom dplyr %>% as_tibble select tibble
+#' @importFrom dplyr as_tibble select tibble
 #' @name tutorials
 NULL
 
@@ -31,10 +31,10 @@ run_tute <- function(tute) {
                                                name = "Checking tutorials in stocnet packages"), 
                        function(p){
                          dplyr::as_tibble(learnr::available_tutorials(package = avail_pkgs[p]),
-                                          silent = TRUE) %>% dplyr::select(1:3)
+                                          silent = TRUE) |> dplyr::select(1:3)
                        })
-    dplyr::bind_rows(tutelist) %>% 
-      dplyr::arrange(dplyr::across(dplyr::any_of("name"))) %>% 
+    dplyr::bind_rows(tutelist) |> 
+      dplyr::arrange(dplyr::across(dplyr::any_of("name"))) |> 
       print()
     manynet::snet_info("You can run a tutorial by typing e.g `run_tute('tutorial1')` or `run_tute('Data')` into the console.")
   } else {
@@ -46,7 +46,7 @@ run_tute <- function(tute) {
     tutelist <- lapply(manynet::snet_progress_along(avail_pkgs, 
                                                name = "Checking tutorials in stocnet packages"), function(p){
                                                  dplyr::as_tibble(learnr::available_tutorials(package = avail_pkgs[p]),
-                                                                  silent = TRUE) %>% dplyr::select(1:3)
+                                                                  silent = TRUE) |> dplyr::select(1:3)
                                                })
     avails <- dplyr::bind_rows(tutelist)
     inftit <- grepl(tute, avails$title, ignore.case = TRUE)
@@ -72,10 +72,10 @@ extract_tute <- function(tute) {
     tutelist <- lapply(manynet::snet_progress_along(avail_pkgs, 
                                                name = "Checking tutorials in stocnet packages"), function(p){
                                                  dplyr::as_tibble(learnr::available_tutorials(package = avail_pkgs[p]),
-                                                                  silent = TRUE) %>% dplyr::select(1:3)
+                                                                  silent = TRUE) |> dplyr::select(1:3)
                                                })
-    dplyr::bind_rows(tutelist) %>% 
-      dplyr::arrange(dplyr::across(dplyr::any_of("name"))) %>% 
+    dplyr::bind_rows(tutelist) |> 
+      dplyr::arrange(dplyr::across(dplyr::any_of("name"))) |> 
       print()
     manynet::snet_info("You can extract the code from one of these tutorials by typing e.g `extract_tute('tutorial1')` into the console.")
   } else {

inst/tutorials/tutorial0/tutorial0.Rmd

@@ -105,7 +105,7 @@
 Remove the hash symbol at the start of this line to run it:
 
 ```{r comments, exercise = TRUE}
 # 1/5 # this will still be commented...
 ```
 
 In an R script you can toggle commenting for one or more lines using Cmd-Shift-C/Ctrl-Shift-C.
@@ -148,9 +148,9 @@
 In R, we can write such logical statements as:
 
 ```{r equivalence, exercise = TRUE}
 "James"=="james" # Try also "James"!="james"
 # Other logical statements include: ">", ">=", "<=", "<".
 # 1 < 5 # Try also "1 <= 5"
 ```
 
 Logical values are always either `TRUE` or `FALSE`,
@@ -168,10 +168,10 @@
 
 ```{r assignment, exercise = TRUE}
 surname <- "Hollway"
 y.chromosome <- T # or TRUE
 siblings <- 1
 age <- NA # This is used for missing information
 # Note that these objects then appear in RStudio's environment pane 
 # (by default the top right)
 ```
 
@@ -187,7 +187,7 @@
 And even operate on them:
 
 ```{r mult, exercise = TRUE, exercise.setup = "assignment"}
 siblings*3
 # Try multiplying the other objects by 3
 ```
 
@@ -212,10 +212,10 @@
 ```{r series, exercise = TRUE}
 teenageyrs <- 13:19
 teenageqrtrs <- seq(13, 19.99, by = 0.25)
 # We can recall every third value from this object using a repeating vector 
 teenageqrtrs
 teenageqrtrs[c(FALSE, FALSE, TRUE)]
 # teenageqrtrs[c(F, F, T)] 
 # Also works but it is best practice to write out the logic.
 ```
 
@@ -384,7 +384,7 @@
 ### Pipes
 
 When working with multiple functions on the same object,
-we can use pipe operators `%>%` or `|>` to chain consecutive functions
+we can use the pipe operator `|>` to chain consecutive functions
 and avoid nesting multiple functions in the code.
 Pipes take the result of the code on the left of the pipe operator
 and uses it in whatever function is on the right or next line of the pipe operator.
@@ -396,19 +396,13 @@
 pipe.result.1 <- example.vector |>
   mean()
 pipe.result.1
-
-# library(dplyr)
-# pipe.result.2 <- example.vector %>%
-  # mean()
-# both pipe operators give the same result 
-# pipe.result.1 == pipe.result.2
 ```
 
-While `|>`is the native pipe operator since R v4.0.0,
-those using earlier versions of R may wish to use `%>%` 
-from either the `{magrittr}` or `{dplyr}` packages.
-Note that in that case, the package would need to be loaded first
-before you can use the operator.
+`|>` is R's native pipe operator, available since R v4.1.0.
+You may still come across `%>%` in older code and tutorials,
+which does much the same thing but comes
+from either the `{magrittr}` or `{dplyr}` packages,
+and so requires that package to be loaded first.
 
 ## Tasks
 

inst/tutorials/tutorial7/diffusion.Rmd

@@ -331,7 +331,7 @@ but different races have different resistances (i.e. thresholds).
 Let us say that there is a clear ordering to this.
 
 ```{r lotr-resist, exercise=TRUE, fig.width=9}
-lotr_resist <- fict_lotr %>% mutate(resistance = dplyr::case_when(Race == "Dwarf" ~ 2,
+lotr_resist <- fict_lotr |> mutate(resistance = dplyr::case_when(Race == "Dwarf" ~ 2,
                                                    Race == "Elf" ~ 4,
                                                    Race == "Ent" ~ 5,
                                                    Race == "Hobbit" ~ 3,
@@ -452,8 +452,8 @@ one with the first node as seed and again one on the middle.
 ```{r lattice-solution}
 plot(play_diffusion(lat, seeds = 1))
 plot(play_diffusion(lat, seeds = 16))
-lat %>%
-  add_node_attribute("color", c(1, rep(0, 14), 2, rep(0, 16))) %>%
+lat |>
+  add_node_attribute("color", c(1, rep(0, 14), 2, rep(0, 16))) |>
   graphr(node_color = "color")
 
 # visualise diffusion in lattice graph
@@ -481,10 +481,10 @@ We could use these on degree centrality, or perhaps some other kind of centralit
 
 ```{r sf, exercise=TRUE, fig.width=9}
 sf <- generate_scalefree(32, 0.025)
-sf %>%
-  as_tidygraph() %>%
+sf |>
+  as_tidygraph() |>
   mutate(degree = ifelse(node_is_max(node_by_degree(sf)) == TRUE, "max",
-                      ifelse(node_is_min(node_by_degree(sf)) == TRUE, "min", "others"))) %>%
+                      ifelse(node_is_min(node_by_degree(sf)) == TRUE, "min", "others"))) |>
   graphr(node_color = "degree") + guides(color = "legend")
 ```
 
@@ -525,7 +525,7 @@ Many of them are implemented here and might be considered as strategies:
 - `node_is_mentor()` identifies high indegree nodes as mentors
 
 ```{r indepsets, exercise = TRUE, exercise.setup="sf", fig.width=9}
-sf %>% mutate_nodes(ni = node_is_independent()) %>% graphr(node_color = "ni")
+sf |> mutate_nodes(ni = node_is_independent()) |> graphr(node_color = "ni")
 plot(play_diffusion(sf, seeds = node_is_independent(sf), steps = 10))
 ```
 
@@ -920,14 +920,14 @@ Then play the learning model with these beliefs, and plot the result.
 
 ```{r degroot-hint, purl = FALSE}
 beliefs <- rbinom(net_nodes(____), 1, prob = 0.25)
-____ %>% mutate(____ = beliefs) %>% graphr(node_color = "____")
+____ |> mutate(____ = beliefs) |> graphr(node_color = "____")
 netlearn <- play_learning(____, ____)
 plot(____)
 ```
 
 ```{r degroot-solution}
 beliefs <- rbinom(net_nodes(ison_networkers), 1, prob = 0.25)
-ison_networkers %>% mutate(beliefs = beliefs) %>% graphr(node_color = "beliefs")
+ison_networkers |> mutate(beliefs = beliefs) |> graphr(node_color = "beliefs")
 (netlearn <- play_learning(ison_networkers, beliefs))
 plot(netlearn)
 ```
@@ -969,12 +969,12 @@ Which are the highest eigenvector centrality nodes in this network?
 
 ```{r eigen-hint}
 node_by_eigenvector(ison_networkers)
-ison_networkers %>% 
-  mutate(who_to_convince = node_is_max(node_by_eigenvector(ison_networkers))) %>% 
+ison_networkers |> 
+  mutate(who_to_convince = node_is_max(node_by_eigenvector(ison_networkers))) |> 
   graphr(node_color = who_to_convince)
 beliefs2 <- rep(0, net_nodes(ison_networkers))
 beliefs2[node_is_max(node_by_eigenvector(ison_networkers))] <- 1
-ison_networkers %>% mutate(beliefs = beliefs2) %>% graphr(node_color = "beliefs")
+ison_networkers |> mutate(beliefs = beliefs2) |> graphr(node_color = "beliefs")
 (netlearn2 <- play_learning(ison_networkers, beliefs2))
 plot(netlearn2)
 ```