From d25fd4efeabbe3cdb812c57e95125b1b36703d8f Mon Sep 17 00:00:00 2001 From: "Pavel N. Krivitsky" Date: Sun, 24 Nov 2024 14:47:07 +1100 Subject: [PATCH] Replaced purrr::transpose() with purrr::list_transpose(), which supersedes it. --- DESCRIPTION | 4 ++-- R/InitErgmConstraint.R | 5 +++-- R/InitErgmTerm.R | 36 ++++++++++++++++++------------------ R/InitErgmTerm.coincidence.R | 6 +++--- 4 files changed, 26 insertions(+), 25 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index c3fbdaa81..05b6f8e23 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: ergm -Version: 4.7.5-7458 -Date: 2024-11-04 +Version: 4.7.5-7485 +Date: 2024-11-24 Title: Fit, Simulate and Diagnose Exponential-Family Models for Networks Authors@R: c( person(c("Mark", "S."), "Handcock", role=c("aut"), email="handcock@stat.ucla.edu"), diff --git a/R/InitErgmConstraint.R b/R/InitErgmConstraint.R index d081be948..65f6cb954 100644 --- a/R/InitErgmConstraint.R +++ b/R/InitErgmConstraint.R @@ -319,8 +319,9 @@ InitErgmConstraint.blocks <- function(nw, arglist, ...) { offset <- 0L } - levels2_list <- transpose(expand.grid(row = row_levels, - col = col_levels, stringsAsFactors = FALSE)) + levels2_list <- list_transpose(expand.grid(row = row_levels, + col = col_levels, stringsAsFactors = FALSE), + simplify = FALSE) indices2_grid <- expand.grid(row = seq_along(row_levels), col = offset + seq_along(col_levels)) diff --git a/R/InitErgmTerm.R b/R/InitErgmTerm.R index 32ca87dea..e133ef795 100644 --- a/R/InitErgmTerm.R +++ b/R/InitErgmTerm.R @@ -1298,10 +1298,10 @@ InitErgmTerm.b1twostar <- function(nw, arglist, ..., version=packageVersion("erg nr <- length(b1u) nc <- length(b2u) - levels2.grid <- expand.grid(row = b1u, col = b2u, col2 = b2u, stringsAsFactors=FALSE) - indices2.grid <- expand.grid(row = 1:nr, col = 1:nc, col2 = 1:nc) + levels2.grid <- expand.grid(row = b1u, col = b2u, col2 = b2u, stringsAsFactors=FALSE) %>% unclass() + indices2.grid <- expand.grid(row = 1:nr, col = 1:nc, col2 = 1:nc) %>% unclass() - levels2.list <- transpose(levels2.grid[indices2.grid$col <= indices2.grid$col2,]) + levels2.list <- list_transpose(levels2.grid[indices2.grid$col <= indices2.grid$col2,], simplify = FALSE) indices2.grid <- indices2.grid[indices2.grid$col <= indices2.grid$col2,] levels2.sel <- if((!hasName(attr(a,"missing"), "levels2") || attr(a,"missing")["levels2"]) && any(a$base != 0)) levels2.list[-a$base] @@ -1873,10 +1873,10 @@ InitErgmTerm.b2twostar <- function(nw, arglist, ..., version=packageVersion("erg nr <- length(b1u) nc <- length(b2u) - levels2.grid <- expand.grid(row = b2u, col = b1u, col2 = b1u, stringsAsFactors=FALSE) - indices2.grid <- expand.grid(row = 1:nc, col = 1:nr, col2 = 1:nr) + levels2.grid <- expand.grid(row = b2u, col = b1u, col2 = b1u, stringsAsFactors=FALSE) %>% unclass() + indices2.grid <- expand.grid(row = 1:nc, col = 1:nr, col2 = 1:nr) %>% unclass() - levels2.list <- transpose(levels2.grid[indices2.grid$col <= indices2.grid$col2,]) + levels2.list <- list_transpose(levels2.grid[indices2.grid$col <= indices2.grid$col2,], simplify = FALSE) indices2.grid <- indices2.grid[indices2.grid$col <= indices2.grid$col2,] levels2.sel <- if((!hasName(attr(a,"missing"), "levels2") || attr(a,"missing")["levels2"]) && any(NVL(a$base,0)!=0)) levels2.list[-a$base] @@ -2946,8 +2946,8 @@ InitErgmTerm.hammingmix<-function (nw, arglist, ..., version=packageVersion("erg nr <- length(u) nc <- length(u) - levels2.list <- transpose(expand.grid(row = u, col = u, stringsAsFactors=FALSE)) - indices2.grid <- expand.grid(row = 1:nr, col = 1:nc) + levels2.list <- list_transpose(expand.grid(row = u, col = u, stringsAsFactors=FALSE), simplify = FALSE) + indices2.grid <- expand.grid(row = 1:nr, col = 1:nc) %>% unclass() levels2.sel <- if((!hasName(attr(a,"missing"), "levels2") || attr(a,"missing")["levels2"]) && any(NVL(a$base,0)!=0)) levels2.list[-a$base] else ergm_attr_levels(a$levels2, list(row = nodecov, col = nodecov), nw, levels2.list) @@ -3495,18 +3495,18 @@ InitErgmTerm.mm<-function (nw, arglist, ..., version=packageVersion("ergm")) { map_if(~length(.)==2, ~call("~", .[[2]], .[[2]])) %>% # Convert ~X to X~X. map(as.list) %>% map(~.[-1]) %>% # Convert to list(X,X). map(set_names, c("row", "col")) %>% # Name elements rowspec and colspec. - transpose() %>% + list_transpose(simplify = FALSE) %>% unlist(recursive=FALSE) %>% # Convert into a flat list. map_if(~is.name(.)&&.==".", ~NULL) %>% # If it's just a dot, convert to NULL. map_if(~is.call(.)||(is.name(.)&&.!="."), ~as.formula(call("~", .))) %>% # If it's a call or a symbol, embed in formula. relist(skeleton=list(row=c(attrs=NA, levels=NA), col=c(attrs=NA, levels=NA))) %>% # Reconstruct list. - transpose() + list_transpose(simplify = FALSE) if(is(a$attrs, "formula")) spec[["attrs"]] <- lapply(spec[["attrs"]], function(x){if(is(x,"formula")) environment(x) <- environment(a$attrs); x}) if(is(a$levels, "formula")) spec[["levels"]] <- lapply(spec[["levels"]], function(x){if(is(x,"formula")) environment(x) <- environment(a$levels); x}) - spec <- transpose(spec) + spec <- list_transpose(spec, simplify = FALSE) # Extract attribute values. attrval <- @@ -3547,8 +3547,8 @@ InitErgmTerm.mm<-function (nw, arglist, ..., version=packageVersion("ergm")) { }) # Construct all pairwise level combinations (table cells) and their numeric codes. - levels2codes <- expand.grid(row=attrval$row$levelcodes, col=attrval$col$levelcodes) %>% transpose() - levels2 <- expand.grid(row=attrval$row$levels, col=attrval$col$levels, stringsAsFactors=FALSE) %>% transpose() + levels2codes <- expand.grid(row=attrval$row$levelcodes, col=attrval$col$levelcodes) %>% unclass() %>% list_transpose(simplify = FALSE) + levels2 <- expand.grid(row=attrval$row$levels, col=attrval$col$levels, stringsAsFactors=FALSE) %>% unclass() %>% list_transpose(simplify = FALSE) # Drop redundant table cells if symmetrising. if(symm){ @@ -3575,7 +3575,7 @@ InitErgmTerm.mm<-function (nw, arglist, ..., version=packageVersion("ergm")) { # Construct the level names levels2names <- levels2 %>% - transpose() %>% + list_transpose(simplify = FALSE) %>% map(unlist) %>% with(paste0( "[", @@ -4181,8 +4181,8 @@ InitErgmTerm.nodemix<-function (nw, arglist, ..., version=packageVersion("ergm") nr <- length(b1namescov) nc <- length(b2namescov) - levels2.list <- transpose(expand.grid(row = b1namescov, col = b2namescov, stringsAsFactors=FALSE)) - indices2.grid <- expand.grid(row = 1:nr, col = nr + 1:nc) + levels2.list <- expand.grid(row = b1namescov, col = b2namescov, stringsAsFactors=FALSE) %>% unclass() %>% list_transpose(simplify = FALSE) + indices2.grid <- expand.grid(row = 1:nr, col = nr + 1:nc) %>% unclass() if ((!hasName(attr(a,"missing"), "levels2") || attr(a,"missing")["levels2"]) && any(NVL(a$base,0)!=0)) { levels2.sel <- levels2.list[-a$base] @@ -4240,8 +4240,8 @@ InitErgmTerm.nodemix<-function (nw, arglist, ..., version=packageVersion("ergm") nr <- length(u) nc <- length(u) - levels2.list <- transpose(expand.grid(row = u, col = u, stringsAsFactors=FALSE)) - indices2.grid <- expand.grid(row = 1:nr, col = 1:nc) + levels2.list <- expand.grid(row = u, col = u, stringsAsFactors=FALSE) %>% unclass() %>% list_transpose(simplify = FALSE) + indices2.grid <- expand.grid(row = 1:nr, col = 1:nc) %>% unclass() uun <- as.vector(outer(u,u,paste,sep=".")) if (!is.directed(nw)) { diff --git a/R/InitErgmTerm.coincidence.R b/R/InitErgmTerm.coincidence.R index 8ed05fdb8..4341e5c62 100644 --- a/R/InitErgmTerm.coincidence.R +++ b/R/InitErgmTerm.coincidence.R @@ -38,7 +38,7 @@ InitErgmTerm.coincidence<-function(nw, arglist, ..., version=packageVersion("erg vartypes = c("matrix","numeric"), defaultvalues = list(NULL,0), required = c(FALSE,FALSE)) - levels <- if(!is.null(a$d)) I(transpose(data.frame(node1 = a$d[,1], node2 = a$d[,2]))) else NULL + levels <- if(!is.null(a$d)) I(list_transpose(list(node1 = a$d[,1], node2 = a$d[,2]), simplify = FALSE)) else NULL }else{ a <- check.ErgmTerm(nw, arglist, directed=FALSE, bipartite=TRUE, varnames = c("levels","active"), @@ -54,10 +54,10 @@ InitErgmTerm.coincidence<-function(nw, arglist, ..., version=packageVersion("erg # this behavior is preserved here, although it violates the convention used by other terms levels2.grid <- expand.grid(node2 = 1:nb2, node1 = 1:nb2) levels2.grid <- levels2.grid[,c(2,1)] # make the second column vary fastest - levels2.grid <- levels2.grid[levels2.grid$node1 < levels2.grid$node2,] + levels2.grid <- levels2.grid[levels2.grid$node1 < levels2.grid$node2,] %>% unclass() if(!is.null(levels)) { - levels2.list <- transpose(levels2.grid) + levels2.list <- list_transpose(levels2.grid, simplify = FALSE) levels2.sel <- ergm_attr_levels(levels, list(node1 = 1:nb2, node2 = 1:nb2), nw, levels2.list) active <- !is.na(match(levels2.list, levels2.sel))