subnetwork_templates() now has a subset= argument that enables a subset of constituent networks to be extracted prior to propagating the specified %ergmlhs% settings.

Author: krivit

R/InitErgmTerm.dgw_sp.R

@@ -67,7 +67,7 @@ no_layer_err <- function(instead){
 
 wrap_ergm_sp_call <- function(ergm_name, nw, a, has_base, d0 = FALSE, cache.sp = TRUE, ...) {
   # A "representative" layer network.
-  nw1 <- subnetwork_templates(nw)[[1]]
+  nw1 <- subnetwork_templates(nw, copy.ergmlhs = c())[[1]]
 
   # Construct and call the ergm term with only the arguments it
   # supports.

R/InitErgmTerm.multilayer.R

@@ -79,15 +79,13 @@ InitErgmTerm.L <- function(nw, arglist, ...){
 
   assert_combined_network(nw, "Layer")
 
-  nwl <- subnetwork_templates(nw, copy.ergmlhs = c())
-
   Ls <- ergm_LayerLogics(a$Ls, nw)
 
   w <- rep(1, length(Ls))
   have.LHS <- lengths(Ls) == 3
   w[have.LHS] <- as.numeric(sapply(lapply(Ls[have.LHS], "[[", 2), eval, environment(Ls[[1]])))
 
-  nw1 <- nwl[[1]]
+  nw1 <- subnetwork_templates(nw, copy.ergmlhs = c())[[1L]]
   m <- ergm_model(a$formula, nw1, ..., offset.decorate=FALSE)
 
   ## FIXME: Is this consistent with extended state API, or do we need to have a different "model" for each layer?

R/InitErgmTerm.multinet.R

@@ -162,10 +162,8 @@ InitErgmTerm.N <- function(nw, arglist, ..., N.compact_stats=TRUE, .combiner = "
 
   auxiliaries <- base_env(~.subnets)
 
-  nwl <- subnetwork_templates(nw)
-  nwnames <- names(nwl)
-  nn <- length(nwl)
   nattrs <- as_tibble(nw, unit="networks")
+  nn <- nrow(nattrs)
 
   lmi <- get_lminfo(nattrs, lm=a$lm, subset=a$subset, contrasts=a$contrasts, offset=a$offset, weights=a$weights)
 
@@ -175,7 +173,7 @@ InitErgmTerm.N <- function(nw, arglist, ..., N.compact_stats=TRUE, .combiner = "
   weights <- lmi$weights
   offset <- lmi$offset
   nm <- sum(subset)
-  nwl <- nwl[subset]
+  nwl <- subnetwork_templates(nw, subset = subset)
   rm(lmi)
 
   ms <- lapply(nwl, function(nw1){

R/combine.networks.R

@@ -252,15 +252,16 @@ ergm.multi_combiner <- local({
 #' This utility uncombines a [combine_networks()] network using subnetwork cache (which contains only empty networks). It is used primarily by initialisation functions.
 #'
 #' @param nw see [uncombine_network()].
-#'
-#' @param copy.ergmlhs a character vector of [`%ergmlhs%`] settings that are to be copied into the constituent networks.
+#' @param copy.ergmlhs a character vector of [`%ergmlhs%`] settings
+#'   that are to be copied into the constituent networks.
+#' @param subset indices of the constituent networks to return.
 #'
 #' @return A list of [`network`]s.
 #'
 #' @keywords internal
 #' @export
-subnetwork_templates <- function(nw, copy.ergmlhs = c("response")){
-  nwl <- uncombine_network(nw, populate = FALSE)
+subnetwork_templates <- function(nw, copy.ergmlhs = c("response"), subset = TRUE) {
+  nwl <- uncombine_network(nw, populate = FALSE)[subset]
 
   if (length(copy.ergmlhs)) nwl <- map(nwl, function(nw1) {
     for (name in copy.ergmlhs) nw1%ergmlhs%name <- nw%ergmlhs%name