Skip to content

Commit

Permalink
Calculation for empty network stats for degree 0 in b*deg*() terms wa…
Browse files Browse the repository at this point in the history 
…s broken by the abstraction.

fixes #591
  • Loading branch information
@krivit
krivit committed Dec 27, 2024
1 parent d0c5e5c commit 20107f8
Show file tree
Hide file tree
Showing 3 changed files with 26 additions and 26 deletions.
4 changes: 2 additions & 2 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: ergm
Version: 4.8.0-7505
Date: 2024-12-22
Version: 4.8.0-7524
Date: 2024-12-27
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"),
Expand Down
8 changes: 4 additions & 4 deletions R/InitErgmTerm.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -223,7 +223,7 @@ decay_vs_fixed <- function(a, name, no_curved_attrarg=TRUE){
} else {
if (any(from==0)) {
emptynwstats <- rep(0, length(from))
emptynwstats[from==0] <- network.size(nw)
emptynwstats[from==0] <- switch(deg, b1 = nw %n% "bipartite", b2 = network.size(nw) - nw %n% "bipartite", network.size(nw))
}
}
if(is.null(byarg)) {
Expand Down Expand Up @@ -293,7 +293,7 @@ decay_vs_fixed <- function(a, name, no_curved_attrarg=TRUE){
} else {
if (any(d==0)) {
emptynwstats <- rep(0, length(d))
emptynwstats[d==0] <- network.size(nw)
emptynwstats[d==0] <- switch(deg, b1 = nw %n% "bipartite", b2 = network.size(nw) - nw %n% "bipartite", network.size(nw))
}
}
if(is.null(byarg)) {
Expand All @@ -311,7 +311,7 @@ decay_vs_fixed <- function(a, name, no_curved_attrarg=TRUE){
if(ncol(du)==0) {return(NULL)}
# No covariates here, so "ParamsBeforeCov" unnecessary
# See comment in d_degree_by_attr function
coef.names <- paste0(deg, "deg", du[1,], ".", attrname,u[du[2,]])
coef.names <- paste0(deg, "deg", du[1,], ".", attrname, ".", u[du[2,]])
name <- paste0(degname, "degree_by_attr")
inputs <- c(as.vector(du), nodecov)
}
Expand Down Expand Up @@ -368,7 +368,7 @@ decay_vs_fixed <- function(a, name, no_curved_attrarg=TRUE){
# No covariates here, so "ParamsBeforeCov" unnecessary
# See comment in c_*degree_by_attr functions
name <- sprintf("gw%sdegree_by_attr", degname)
coef.names <- sprintf("gw%sdeg%s.%s%s", deg, decay, attrname, u)
coef.names <- sprintf("gw%sdeg%s.%s.%s", deg, decay, attrname, u)
inputs <- c(decay, nodecov)
}else{
name <- sprintf("gw%sdegree", degname)
Expand Down
40 changes: 20 additions & 20 deletions tests/testthat/test-term-bipartite.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -48,25 +48,25 @@ test_that("b1cov, bipartite, undirected", {
})

test_that("b1degrange, bipartite, undirected", {
s.d <- summary(bipnw~b1degrange(from=c(1,2),to=c(Inf,Inf)))
s.d <- summary(bipnw~b1degrange(from=c(0,1,2),to=c(3,3,Inf)))
e.d <- ergm(bipnw~b1degrange(from=c(1,2),to=c(Inf,Inf)), estimate="MPLE")
s.anh <- summary(bipnw~b1degrange(from=c(1,2),to=c(Inf,Inf),by="Letter",homophily=FALSE))
s.anh <- summary(bipnw~b1degrange(from=c(0,1,2),to=c(3,3,Inf),by="Letter",homophily=FALSE))
e.anh <- ergm(bipnw~b1degrange(from=c(1,2),to=c(Inf,Inf),by=function(x) x %v% "Letter",homophily=FALSE), estimate="MPLE")
s.dh <- summary(bipnw~b1degrange(from=c(1,2),to=c(Inf,Inf),by="Letter",homophily=TRUE))
s.dh <- summary(bipnw~b1degrange(from=c(0,1,2),to=c(3,3,Inf),by="Letter",homophily=TRUE))
e.dh <- ergm(bipnw~b1degrange(from=c(1,2),to=c(Inf,Inf),by=function(x) x %v% "Letter",homophily=TRUE), estimate="MPLE")
expect_summary(s.d, e.d, c(42,12), c(-4.027, -3.961))
expect_summary(s.anh, e.anh, c(13,4,13,5,16,3), c(-4.215, -4.143, -4.284, -3.620, -3.636, -4.105))
expect_summary(s.dh, e.dh, c(19,3), c(-3.891, -3.143))
expect_summary(s.d, e.d, c(96,38,12), c(-4.027, -3.961))
expect_summary(s.anh, e.anh, c(32,11,4,31,11,5,33,16,3), c(-4.215, -4.143, -4.284, -3.620, -3.636, -4.105))
expect_summary(s.dh, e.dh, c(100,19,3), c(-3.891, -3.143))
})

test_that("b1degree, bipartite, undirected", {
s.d <- summary(bipnw~b1degree(1:3))
s.d <- summary(bipnw~b1degree(0:3))
e.d <- ergm(bipnw~b1degree(1:3), estimate="MPLE")
s.db <- summary(bipnw~b1degree(2:4, by="Letter"))
s.db <- summary(bipnw~b1degree(c(0,2:4), by="Letter"))
e.db <- ergm(bipnw~b1degree(2, by=~Letter), estimate="MPLE")

expect_summary(s.d, e.d, c(30,8,2), -c(2.991, 5.442, 6.484))
expect_summary(s.db, e.db, c(2,1,1,3,1,1,3,0,0), -c(1.481, .959, 1.431))
expect_summary(s.d, e.d, c(58,30,8,2), -c(2.991, 5.442, 6.484))
expect_summary(s.db, e.db, c(21,2,1,1,20,3,1,1,17,3,0,0), -c(1.481, .959, 1.431))
})

test_that("b1dsp, bipartite", {
Expand Down Expand Up @@ -158,25 +158,25 @@ test_that("b2cov, bipartite, undirected", {
})

test_that("b2degrange, bipartite, undirected", {
s.d <- summary(bipnw~b2degrange(from=c(1,2),to=c(Inf,Inf)))
s.d <- summary(bipnw~b2degrange(from=c(0,1,2),to=c(3,3,Inf)))
e.d <- ergm(bipnw~b2degrange(from=c(1,2),to=c(Inf,Inf)), estimate="MPLE")
s.anh <- summary(bipnw~b2degrange(from=c(1,2),to=c(Inf,Inf),by=function(x) x %v% "Letter",homophily=FALSE))
s.anh <- summary(bipnw~b2degrange(from=c(0,1,2),to=c(3,3,Inf),by=function(x) x %v% "Letter",homophily=FALSE))
(e.anh <- ergm(bipnw~b2degrange(from=c(1,2),to=c(Inf,Inf),by=~Letter,homophily=FALSE), estimate="MPLE")) |>
expect_warning("The MPLE does not exist!")
s.dh <- summary(bipnw~b2degrange(from=c(1,2),to=c(Inf,Inf),by=function(x) x %v% "Letter",homophily=TRUE))
s.dh <- summary(bipnw~b2degrange(from=c(0,1,2),to=c(3,3,Inf),by=function(x) x %v% "Letter",homophily=TRUE))
e.dh <- ergm(bipnw~b2degrange(from=c(1,2),to=c(Inf,Inf),by=~Letter,homophily=TRUE), estimate="MPLE")
expect_summary(s.d, e.d, c(26,20), -c(3.912,3.497))
expect_summary(s.anh, e.anh, c(9,8,10,6,7,6), -c(-13.566, 2.803, -14.365, 4.190, 5.704, 2.803))
expect_summary(s.dh, e.dh, c(19,3), -c(3.03, 4.46))
expect_summary(s.d, e.d, c(18,15,20), -c(3.912,3.497))
expect_summary(s.anh, e.anh, c(4,4,8,7,7,6,7,4,6), -c(-13.566, 2.803, -14.365, 4.190, 5.704, 2.803))
expect_summary(s.dh, e.dh, c(29,19,3), -c(3.03, 4.46))
})

test_that("b2degree, bipartite, undirected", {
s.d <- summary(bipnw~b2degree(1:3))
s.d <- summary(bipnw~b2degree(0:3))
e.d <- ergm(bipnw~b2degree(1:3), estimate="MPLE")
s.db <- summary(bipnw~b2degree(2:4, by="Letter"))
s.db <- summary(bipnw~b2degree(0:3, by="Letter"))
e.db <- ergm(bipnw~b2degree(2, by=~Letter), estimate="MPLE")
expect_summary(s.d, e.d, c(6,9,8), c(1.7203, 1.4941, .6768))
expect_summary(s.db, e.db, c(3,2,3,3,3,0,3,3,0), c(1.0498, -.3001, 1.0217))
expect_summary(s.d, e.d, c(3,6,9,8), c(1.7203, 1.4941, .6768))
expect_summary(s.db, e.db, c(0,1,3,2,0,4,3,3,3,1,3,3), c(1.0498, -.3001, 1.0217))
})

test_that("b2dsp, bipartite", {
Expand Down

0 comments on commit 20107f8

Please sign in to comment.