Layer() now ensures that the layer names are set early (simplifying name map extraction), and performs some additional checks around network attributes, including checking for reserved vertex attributes.

Author: krivit

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ergm.multi
-Version: 0.3.0-4261
-Date: 2026-03-20
+Version: 0.3.0-4275
+Date: 2026-03-21
 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"),

R/multilayer.R

@@ -27,14 +27,18 @@ network.layercount <- function(x, ...) {
   map(nwl, `%ergmlhs%`, nattr) %>% map(NVL, ~.) %>% map(empty_env) %>% all_identical
 }
 
-
-.varying_attributes <- function(nwl, lister, getter, type, ignore = c()){
-  attrs1 <- lister(nwl[[1]]) %>% setdiff(ignore)
-  attrs <- nwl[-1] %>% map(lister) %>% map(setdiff, ignore)
+.varying_attributes <- function(nwl, lister, getter, type, ignore = c(), reserved = c()) {
+  attrs1 <- lister(nwl[[1]]) %>% setdiff(c(ignore, reserved))
+  attrs <- nwl[-1] %>% map(lister) %>% map(setdiff, c(ignore, reserved))
   extra_attrs <- attrs %>% unlist() %>% unique() %>% setdiff(attrs1)
 
+  for (res in reserved) {
+    found <- names(nwl)[map_lgl(c(list(attrs1), attrs), \(a) res %in% a)]
+    if (length(found)) warning(type, " attribute ", dQuote(res), " found in layer(s) ", dQuote(found), " is reserved by ", sQuote("Layer()"), " and will be overwritten.", immediate. = TRUE)
+  }
+
   if(length(extra_attrs))
-    message(type, " attribute(s) ", paste.and(sQuote(extra_attrs)), " are not found in the first layer and will not be visible to the ", sQuote("formula"), " in ", sQuote("L(formula, Ls)"), ".")
+    message(type, " attribute(s) ", paste.and(dQuote(extra_attrs)), " are not found in the first layer and will not be visible to the ", sQuote("formula"), " in ", sQuote("L(formula, Ls)"), ".")
 
   common_attrs <- attrs %>% map(intersect, attrs1)
   differing <-
@@ -44,20 +48,16 @@ network.layercount <- function(x, ...) {
         function(nw, al) if(a %in% al) identical(getter(nw, a, unlist = FALSE), getter(nwl[[1]], a, unlist = FALSE)) else TRUE
       ) %>% all())
   if(any(differing))
-    message(type, " attribute(s) ", paste.and(sQuote(attrs1[differing])), " have values different from those in the first layer; ", sQuote("formula"), " in ", sQuote("L(formula, Ls)"), " will not see them.")
+    message(type, " attribute(s) ", paste.and(dQuote(attrs1[differing])), " have values different from those in the first layer; ", sQuote("formula"), " in ", sQuote("L(formula, Ls)"), " will not see them.")
 
   length(extra_attrs) || any(differing)
 }
 
 
 .layer_namemap <- function(nw) {
   if (is(nw, "network")) {
-    nwnames <- get_combining_attr(nw, ".LayerName", missing = "NULL")
-    if (is.numeric(nwnames)) nwnames <- NULL
-    nwids <- get_combining_attr(nw, ".LayerID")
-
-    o <- structure(nwids, names = nwnames %||% as.character(nwids))
-    o[!duplicated(o)]
+    nwl <- subnetwork_templates(nw, ".LayerID", ".LayerName", copy.ergmlhs = c())
+    setNames(seq_along(nwl), names(nwl))
   } else nw
 }
 
@@ -512,9 +512,22 @@ Layer <- function(..., .symmetric=NULL, .bipartite=NULL, .active=NULL){
 
   }else stop("Unrecognized format for multilayer specification. See help for information.")
 
+  # Perform some checks and imputations for layer names.
+  if (is.null(nnames <- names(nwl))) nnames <- as.character(seq_along(nnames))
+  else if (any(blank <- nnames == "")) {
+    message("Layer(s) ", paste.and(which(blank)), " do not have specified names; they have been imputed with the corresponding layer number.")
+    nnames[blank] <- as.character(seq_along(nnames)[blank])
+  }
+  if(any(weird <-
+    regexpr("^[0-9]+$", nnames) != -1L # Names that are integers are potentially problematic,
+    & nnames != seq_along(nnames) # but not if they happen to match layer IDs.
+  )) warning("Using numeric layer names (", paste.and(dQuote(nnames[weird])), ") is ambiguous.", immediate. = TRUE)
+  if (anyDuplicated(nnames)) stop("Duplicate layer names.")
+  names(nwl) <- nnames
+
   ## If network or vertex attributes differ from the first network, warn.
   .varying_attributes(nwl, list.network.attributes, get.network.attribute, "Network", ignore = c("directed", "bipartite", "mnext", ".block_blacklist"))
-  .varying_attributes(nwl, list.vertex.attributes, get.vertex.attribute, "Vertex", ignore = c(".undirected", ".bipartite", ".ubid"))
+  .varying_attributes(nwl, list.vertex.attributes, get.vertex.attribute, "Vertex", ignore = c(".ubid"), reserved = c(".undirected", ".bipartite"))
 
   if(!is.null(.active)){
     if(!is.list(.active) || length(.active) != length(nwl)) stop(sQuote(".active="), " argument if given must be a list of attribute specifications, one for each layer.")
@@ -555,19 +568,6 @@ Layer <- function(..., .symmetric=NULL, .bipartite=NULL, .active=NULL){
   # nwl is now a list of networks with homogeneous directedness, some
   # networks tagged with vertex attribute .undirected.
 
-  # Perform some checks and imputations for layer names.
-  nnames <- names(nwl)
-  if(!is.null(nnames) && any(blank<-(nnames==""))){
-    warning("Only some of the layers have specified names; they have been imputed with the corresponding layer number.")
-    nnames[blank] <- as.character(seq_along(nnames)[blank])
-  }
-  if(any(
-  regexpr('^[0-9]+$',nnames)!=-1 # Names that are integers are potentially problematic,
-  & nnames!=seq_along(nnames) # but not if they happen to match layer IDs.
-  )) warning("Using numeric layer names is ambiguous.")
-  if(anyDuplicated(nnames)) stop("Duplicate layer names.")
-  names(nwl) <- nnames
-
   if(!.same_constraints(nwl, "constraints")) stop("Layers have differing constraint structures. This is not supported at this time.")
   if(!.same_constraints(nwl, "obs.constraints")) stop("Layers have differing observation processes. This is not supported at this time.")
 

tests/testthat/test-multilayer-heterogeneous-directedness.R

@@ -28,15 +28,15 @@ test_that("multilayer heterogeneous layers messages", {
 
   expect_message(expect_message(
     Layer(nw12, nw1),
-    "Vertex attribute\\(s\\) 'mode' are not found in the first layer.*"),
-    "Network attribute\\(s\\) 'nattr' are not found in the first layer.*"
+    "Vertex attribute\\(s\\) \"mode\" are not found in the first layer.*"),
+    "Network attribute\\(s\\) \"nattr\" are not found in the first layer.*"
   )
 
   nw12 %v% "mode" <- rep(1:2,c(15,5))
   nw12 %n% "nattr" <- "def"
   expect_message(expect_message(
     Layer(nw1, nw12, .active=list(~mode==1, ~TRUE)),
-    "Vertex attribute\\(s\\) 'mode' have values different from those in the first layer.*"),
-    "Network attribute\\(s\\) 'nattr' have values different from those in the first layer.*"
+    "Vertex attribute\\(s\\) \"mode\" have values different from those in the first layer.*"),
+    "Network attribute\\(s\\) \"nattr\" have values different from those in the first layer.*"
   )
 })

tests/testthat/test-multilayer.R

@@ -32,7 +32,20 @@ ctrl <- control.simulate.formula(MCMC.burnin=n^2*2, MCMC.interval=n)
 
 test_that("twostarL statistics for directed networks", {
   nw1 <- nw2 <- network.initialize(n, directed = TRUE)
-  lnw <- Layer(nw1, nw2)
+  # Duplicate layer name.
+  expect_warning(expect_message(expect_error(lnw <- Layer(nw1, `1` = nw2),
+                                             "Duplicate layer names."),
+                                "Layer\\(s\\) 1 do not have specified names.*"),
+                 "Using numeric layer names \\(\"1\"\\) is ambiguous.")
+
+  # Reserved attribute and non-duplicate numeric layer name.
+  nw1 %v% ".undirected" <- FALSE
+  expect_message(expect_warning(lnw <- Layer(nw1, `123` = nw2),
+                                "Using numeric layer names \\(\"123\"\\) is ambiguous."),
+                 "Layer\\(s\\) 1 do not have specified names.*")
+
+  # OK numeric layer name.
+  expect_message(lnw <- Layer(`1` = nw1, nw2), "Layer\\(s\\) 2 do not have .*")
 
   sim <- suppressWarnings(simulate(lnw~
                     twostarL(c(~`1`,~`2`), "out",FALSE)+