%ergmlhs% constraint settings now use term_lists and helper functions.

Author: krivit

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ergm.multi
-Version: 0.3.0-4260
-Date: 2026-03-18
+Version: 0.3.0-4261
+Date: 2026-03-20
 Title: Fit, Simulate and Diagnose Exponential-Family Models for Multiple or Multilayer Networks
 Authors@R: c(person(c("Pavel", "N."), "Krivitsky", role=c("aut","cre"), email="pavel@statnet.org", comment=c(ORCID="0000-0002-9101-3362")),
              person(c("Mark", "S."), "Handcock", role=c("ctb"), email="handcock@stat.ucla.edu"),
@@ -10,7 +10,7 @@ Authors@R: c(person(c("Pavel", "N."), "Krivitsky", role=c("aut","cre"), email="p
              person("Joyce", "Cheng", role=c("ctb"), email="joyce.cheng@student.unsw.edu.au"))
 Depends:
     R (>= 4.2.0),
-    ergm (>= 4.12.0),
+    ergm (>= 4.13.0),
     network (>= 1.19.0)
 Imports:
     statnet.common (>= 4.14.0),

R/ergmlhs.R

@@ -53,13 +53,26 @@ combine_ergmlhs <- function(nwl, ignore.settings=c()){
 #' @export
 ergmlhs_remove_blockdiag <- function(nw, vattr) {
   if (! vattr %in% list.vertex.attributes(nw)) {
-    nw %ergmlhs% "constraints" <- filter_rhs.formula(nw %ergmlhs% "constraints", function(trm)
-      ! identical(trm, call("blockdiag", vattr, noncontig = "split")))
+    todel <- blockdiag_term_list(vattr)
 
-    ## TODO: filter_rhs.formula() should probably return NULL when it
-    ## deleted all the terms, so if this is ever the case, the
-    ## following could be removed.
-    if (length(nw %ergmlhs% "constraints") < 2) nw %ergmlhs% "constraints" <- NULL
+    con <- ergm_flatten_conterm_list(nw %ergmlhs% "constraints")
+    nw %ergmlhs% "constraints" <- con[map(seq_along(con), \(i) con[i]) |>
+                                      map_lgl(identical, todel) |>
+                                      (`!`)()]
   }
   nw
 }
+
+blockdiag_term_list <- function(vattr) {
+  term_list(call("blockdiag", vattr, noncontig = "split"), env = baseenv())
+}
+
+add_con <- function(x, y, from = x) {
+  con <- ergm_flatten_conterm_list(from %ergmlhs% "constraints") %||%
+    term_list(list())
+  y <- ergm_flatten_conterm_list(y)
+
+  x %ergmlhs% "constraints" <- unique(c(con, y))
+  x %ergmlhs% "obs.constraints" <- from %ergmlhs% "obs.constraints"
+  x
+}

R/multilayer.R

@@ -575,16 +575,10 @@ Layer <- function(..., .symmetric=NULL, .bipartite=NULL, .active=NULL){
 
   nw %n% "ergm" <- combine_ergmlhs(nwl)
 
-  nw %ergmlhs% "constraints" <-
-      if(NVL(nwl[[1]] %ergmlhs% "constraints",base_env(~.))==base_env(~.))
-        base_env(~blockdiag(".LayerID", noncontig = "split"))
-      else
-        append_rhs.formula(nwl[[1]] %ergmlhs% "constraints", list(call("blockdiag", ".LayerID", noncontig = "split")), TRUE)
+  nw <- add_con(nw, blockdiag_term_list(".LayerID"), nwl[[1]])
 
-  if(any(symm)) nw %ergmlhs% "constraints" <- append_rhs.formula(nw %ergmlhs% "constraints", list(call("upper_tri",".undirected")), TRUE)
-  if(any(blockout!=0)||!is.null(.active)) nw %ergmlhs% "constraints" <- append_rhs.formula(nw %ergmlhs% "constraints", list(call("blacklist_block")), TRUE)
-
-  if(!is.null(nwl[[1]]%ergmlhs%"obs.constraints")) nw %ergmlhs% "obs.constraints" <- nwl[[1]] %ergmlhs% "obs.constraints"
+  if(any(symm)) nw <- add_con(nw, term_list(call("upper_tri", ".undirected"), env = baseenv()))
+  if(any(blockout!=0)||!is.null(.active)) nw <- add_con(nw, term_list(call("blacklist_block"), env = baseenv()))
 
   nw
 }

R/multinet.R

@@ -53,13 +53,7 @@ Networks <- function(...){
   nw <- combine_networks(nwl, blockID.vattr=".NetworkID", blockName.vattr=".NetworkName", ignore.nattr = c(eval(formals(combine_networks)$ignore.nattr), "constraints", "obs.constraints", "ergm"), subnet.cache=TRUE)
 
   nw %n% "ergm" <- combine_ergmlhs(nwl)
-
-  nw %ergmlhs% "constraints" <-
-      if(NVL(nwl[[1]] %ergmlhs% "constraints",base_env(~.))==base_env(~.))
-        base_env(~blockdiag(".NetworkID", noncontig = "split"))
-      else
-        append_rhs.formula(nwl[[1]]%ergmlhs%"constraints", list(call("blockdiag", ".NetworkID", noncontig = "split")), TRUE)
-  if(!is.null(nwl[[1]]%ergmlhs%"obs.constraints")) nw %ergmlhs% "obs.constraints" <- nwl[[1]]%ergmlhs%"obs.constraints"
+  nw <- add_con(nw, blockdiag_term_list(".NetworkID"), nwl[[1]])
 
   nw
 }

tests/testthat/test-nesting.R

@@ -21,12 +21,12 @@ test_that("simulation of two multilayer networks with heterogeneous layer counts
   expect_error(unLayer(nw1), ".*not a multilayer network at the top level.*")
   unw <- unNetworks(nw1)
   expect_length(unw, 2L)
-  expect_identical(unw[[1]]  %ergmlhs% "constraints", statnet.common::base_env(~blockdiag(".LayerID", noncontig = "split")))
+  expect_identical(unw[[1]]  %ergmlhs% "constraints", statnet.common::term_list(quote(blockdiag(".LayerID", noncontig = "split")), env = baseenv()))
 
   uunw1 <- unLayer(unw[[1]])
   uunw2 <- unLayer(unw[[2]])
   expect_length(uunw1, 3L)
   expect_length(uunw2, 2L)
 
-  expect_identical(uunw1[[1]]  %ergmlhs% "constraints", NULL)
+  expect_length(uunw1[[1]]  %ergmlhs% "constraints", 0L)
 })