From 1847c404e2b38a376d09cb6c732a43f3a9fae8a7 Mon Sep 17 00:00:00 2001 From: "Pavel N. Krivitsky" Date: Fri, 9 Oct 2026 13:48:51 +1100 Subject: [PATCH 1/2] network's [<- operator for names.eval = NULL (binary mode) now filters out redundant undirected edges and self-loops (when disabled) at an earlier stage and calls edge addition and deletion and edge attribute modification in bulk rather than once per edge affected. --- DESCRIPTION | 4 ++-- R/operators.R | 63 +++++++++++++++++++++++++++++++++++++-------------- 2 files changed, 48 insertions(+), 19 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 342298a..c05ec56 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: network -Version: 1.20.0-784 -Date: 2026-03-02 +Version: 1.20.0-790 +Date: 2026-10-09 Title: Classes for Relational Data Authors@R: c( person("Carter T.", "Butts", role=c("aut","cre"), email="buttsc@uci.edu"), diff --git a/R/operators.R b/R/operators.R index 4a4f7a5..410e379 100644 --- a/R/operators.R +++ b/R/operators.R @@ -322,26 +322,55 @@ out_of_bounds <- function(x, el){ val<-value[cbind(match(el[,1],sort(unique(el[,1]))), match(el[,2],sort(unique(el[,2]))))] else val<-rep(as.vector(value),length.out=NROW(el)) + + #Filter out redundant edges if undirected + if (!is.directed(x)) { + el <- cbind(pmin(el[,1], el[,2]), pmax(el[,1], el[,2])) + u <- !duplicated(el) + if (!all(u)) { + el <- el[u, , drop = FALSE] + val <- val[u] + } + } + + #Filter out self-loops if disabled + if (!has.loops(x) && !all(nonloops <- el[,1] != el[,2])) { + el <- el[nonloops, , drop = FALSE] + val <- val[nonloops] + } + #Perform the changes if(is.null(names.eval)){ #If no names given, don't store values - for (k in seq_along(val)) { - eid <- get.edgeIDs(x,el[k,1],el[k,2],neighborhood="out", na.omit=FALSE) - if (!is.na(val[k]) & val[k] == 0) { - # delete edge - if (length(eid) > 0) x<-delete.edges(x,eid) - } else { - if (length(eid) == 0 & (has.loops(x)|(el[k,1]!=el[k,2]))) { - # add edge if needed - x<-add.edges(x,as.list(el[k,1]),as.list(el[k,2])) - eid <- get.edgeIDs(x,el[k,1],el[k,2],neighborhood="out", na.omit=FALSE) - } - if (is.na(val[k])) { - set.edge.attribute(x,"na",TRUE,eid) # set to NA - } else if (val[k] == 1) { - set.edge.attribute(x,"na",FALSE,eid) # set to 1 - } - } + + el0 <- as.matrix(x, matrix.type = "edgelist", na.rm = FALSE) + if (!is.directed(x)) el0 <- cbind(pmin(el0[,1], el0[,2]), pmax(el0[,1], el0[,2])) + + # Rowwise intersection of el and el0 + inter <- duplicated(rbind(el0, el))[rep(c(FALSE, TRUE), c(nrow(el0), nrow(el)))] + + if (any(inter)) { + todel <- which(inter & !is.na(val) & !val) + to1 <- which(inter & !is.na(val) & val) + toNA <- which(inter & is.na(val)) + + # unlist() is needed in case of multiplex edges. + el_eids <- function(rows) unlist(lapply(rows, function(k) get.edgeIDs(x, el[k,1], el[k,2], neighborhood = "out", na.omit=FALSE))) + + if(length(todel)) delete.edges(x, eid = el_eids(todel)) + if(length(toNA)) set.edge.attribute(x, "na", TRUE, el_eids(toNA)) + if(length(to1)) set.edge.attribute(x, "na", FALSE, el_eids(to1)) } + + if (any(!inter)) { + toinsNA <- which(!inter & is.na(val)) + toins1 <- which(!inter & !is.na(val) & val) + + if (length(toinsNA)) add.edges(x, as.list(el[toinsNA,1]), as.list(el[toinsNA,2]), + names.eval = "na", vals.eval = TRUE) + if (length(toins1)) add.edges(x, as.list(el[toins1,1]), as.list(el[toins1,2]), + names.eval = "na", vals.eval = FALSE) + } + }else{ #An attribute name was given, so store values epresent<-vector() eid<-vector() From 553bb803a16571b7ad0cbde2e0f318e322ea68c9 Mon Sep 17 00:00:00 2001 From: "Pavel N. Krivitsky" Date: Fri, 9 Oct 2026 19:11:13 +1100 Subject: [PATCH 2/2] In [<- method for networks, when removing redundant edges in undirected networks, establish the order (nonzero|nonFALSE, NA, 0|FALSE) in which conflicting values are prioritised. --- R/operators.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/operators.R b/R/operators.R index 410e379..bfbc20d 100644 --- a/R/operators.R +++ b/R/operators.R @@ -326,6 +326,10 @@ out_of_bounds <- function(x, el){ #Filter out redundant edges if undirected if (!is.directed(x)) { el <- cbind(pmin(el[,1], el[,2]), pmax(el[,1], el[,2])) + #Nonzero, nonFALSE values trump NA; NA trumps 0. + o <- order((!is.na(val) & (val == 0 | val == FALSE)) * 2L + is.na(val) * 1L, na.last = FALSE) + el <- el[o, , drop = FALSE] + val <- val[o] u <- !duplicated(el) if (!all(u)) { el <- el[u, , drop = FALSE]