From d0a86327eb90c5b87b61d438ec7ea3eb5f0333fe Mon Sep 17 00:00:00 2001 From: "Pavel N. Krivitsky" Date: Mon, 25 Nov 2024 19:34:16 +1100 Subject: [PATCH] Implemented terms *covrange(), *degm1lfactorial, and *factordistinct(). --- DESCRIPTION | 2 + R/InitErgmTerm.degfactorial.R | 85 ++++++ R/InitErgmTerm.diversity.R | 304 +++++++++++++++++++ man/b1covrange-ergmTerm-24a903d2.Rd | 24 ++ man/b1degm1lfactorial-ergmTerm-268d1fe0.Rd | 20 ++ man/b1factordistinct-ergmTerm-f897b95c.Rd | 27 ++ man/b2covrange-ergmTerm-5e2bcc86.Rd | 24 ++ man/b2degm1lfactorial-ergmTerm-134e4482.Rd | 20 ++ man/b2factordistinct-ergmTerm-076e6026.Rd | 27 ++ man/degm1lfactorial-ergmTerm-0f187aa0.Rd | 19 ++ man/idegm1lfactorial-ergmTerm-4be755fd.Rd | 20 ++ man/nodecovrange-ergmTerm-7ae91499.Rd | 25 ++ man/nodefactordistinct-ergmTerm-3445048c.Rd | 28 ++ man/nodeicovrange-ergmTerm-29a8edd7.Rd | 24 ++ man/nodeifactordistinct-ergmTerm-25cbd312.Rd | 27 ++ man/nodeocovrange-ergmTerm-382e45c5.Rd | 24 ++ man/nodeofactordistinct-ergmTerm-f159e5dc.Rd | 27 ++ man/odegm1lfactorial-ergmTerm-b8eb44b3.Rd | 20 ++ src/changestats_degfactorial.c | 20 ++ src/changestats_diversity.c | 100 ++++++ tests/testthat/test-ergm-term-doc.R | 6 +- tests/testthat/test-term-degfactorial.R | 43 +++ tests/testthat/test-term-diversity.R | 112 +++++++ 23 files changed, 1025 insertions(+), 3 deletions(-) create mode 100644 R/InitErgmTerm.degfactorial.R create mode 100644 R/InitErgmTerm.diversity.R create mode 100644 man/b1covrange-ergmTerm-24a903d2.Rd create mode 100644 man/b1degm1lfactorial-ergmTerm-268d1fe0.Rd create mode 100644 man/b1factordistinct-ergmTerm-f897b95c.Rd create mode 100644 man/b2covrange-ergmTerm-5e2bcc86.Rd create mode 100644 man/b2degm1lfactorial-ergmTerm-134e4482.Rd create mode 100644 man/b2factordistinct-ergmTerm-076e6026.Rd create mode 100644 man/degm1lfactorial-ergmTerm-0f187aa0.Rd create mode 100644 man/idegm1lfactorial-ergmTerm-4be755fd.Rd create mode 100644 man/nodecovrange-ergmTerm-7ae91499.Rd create mode 100644 man/nodefactordistinct-ergmTerm-3445048c.Rd create mode 100644 man/nodeicovrange-ergmTerm-29a8edd7.Rd create mode 100644 man/nodeifactordistinct-ergmTerm-25cbd312.Rd create mode 100644 man/nodeocovrange-ergmTerm-382e45c5.Rd create mode 100644 man/nodeofactordistinct-ergmTerm-f159e5dc.Rd create mode 100644 man/odegm1lfactorial-ergmTerm-b8eb44b3.Rd create mode 100644 src/changestats_degfactorial.c create mode 100644 src/changestats_diversity.c create mode 100644 tests/testthat/test-term-degfactorial.R create mode 100644 tests/testthat/test-term-diversity.R diff --git a/DESCRIPTION b/DESCRIPTION index 8518646a..136bf67d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -79,7 +79,9 @@ Collate: 'InitErgmTerm.bipartite.degree.R' 'InitErgmTerm.blockop.R' 'InitErgmTerm.coincidence.R' + 'InitErgmTerm.degfactorial.R' 'InitErgmTerm.dgw_sp.R' + 'InitErgmTerm.diversity.R' 'InitErgmTerm.extra.R' 'InitErgmTerm.indices.R' 'InitErgmTerm.interaction.R' diff --git a/R/InitErgmTerm.degfactorial.R b/R/InitErgmTerm.degfactorial.R new file mode 100644 index 00000000..0ea024e3 --- /dev/null +++ b/R/InitErgmTerm.degfactorial.R @@ -0,0 +1,85 @@ +#' @templateVar name degm1lfactorial +#' @title Sum of log-factorials of degrees of non-isolates minus 1 +#' @description This term adds one network statistic to the model, +#' equalling \eqn{\sum_{i=1}^n \mathbb{I}(d_i>0) \log(d_i - 1)!}. +#' +#' @usage +#' # binary: degm1lfactorial +#' +#' @template ergmTerm-general +#' +#' @concept undirected +InitErgmTerm.degm1lfactorial <- function(nw, arglist, ..., version=packageVersion("ergm")) { + a <- check.ErgmTerm(nw, arglist) + list(name="sum_lfactorial_degreem1", coef.names="ldegm1lfactorial", minval = 0) +} + + +#' @templateVar name b2degm1lfactorial +#' @title Sum of log-factorials of degrees of Mode-2 non-isolates minus 1 +#' @description This term adds one network statistic to the model, +#' equalling \eqn{\sum_{i=b+1}^n \mathbb{I}(d_i>0) \log(d_i - 1)!}. +#' +#' @usage +#' # binary: b2degm1lfactorial +#' +#' @template ergmTerm-general +#' +#' @concept undirected +#' @concept bipartite +InitErgmTerm.b2degm1lfactorial <- function(nw, arglist, ...) { + a <- check.ErgmTerm(nw, arglist, bipartite = TRUE) + list(name="sum_lfactorial_idegreem1", coef.names="b2degm1lfactorial", minval = 0) +} + + +#' @templateVar name b1degm1lfactorial +#' @title Sum of log-factorials of degrees of Mode-1 non-isolates minus 1 +#' @description This term adds one network statistic to the model, +#' equalling \eqn{\sum_{i=1}^b \mathbb{I}(d_i>0) \log(d_i - 1)!}. +#' +#' @usage +#' # binary: b1degm1lfactorial +#' +#' @template ergmTerm-general +#' +#' @concept undirected +#' @concept bipartite +InitErgmTerm.b1degm1lfactorial <- function(nw, arglist, ...) { + a <- check.ErgmTerm(nw, arglist, bipartite = TRUE) + list(name="sum_lfactorial_odegreem1", coef.names="b1degm1lfactorial", minval = 0) +} + + +#' @templateVar name idegm1lfactorial +#' @title Sum of log-factorials of indegrees of non-in-isolates minus 1 +#' @description This term adds one network statistic to the model, +#' equalling \eqn{\sum_{i=1}^n \mathbb{I}(id_i>0) \log(id_i - 1)!}. +#' +#' @usage +#' # binary: idegm1lfactorial +#' +#' @template ergmTerm-general +#' +#' @concept directed +InitErgmTerm.idegm1lfactorial <- function(nw, arglist, ...) { + a <- check.ErgmTerm(nw, arglist, directed = TRUE) + list(name="sum_lfactorial_idegreem1", coef.names="idegm1lfactorial", minval = 0) +} + + +#' @templateVar name odegm1lfactorial +#' @title Sum of log-factorials of outdegrees of non-out-isolates minus 1 +#' @description This term adds one network statistic to the model, +#' equalling \eqn{\sum_{i=1}^n \mathbb{I}(od_i>0) \log(od_i - 1)!}. +#' +#' @usage +#' # binary: odegm1lfactorial +#' +#' @template ergmTerm-general +#' +#' @concept directed +InitErgmTerm.odegm1lfactorial <- function(nw, arglist, ...) { + a <- check.ErgmTerm(nw, arglist, directed = TRUE) + list(name="sum_lfactorial_odegreem1", coef.names="odegm1lfactorial", minval = 0) +} diff --git a/R/InitErgmTerm.diversity.R b/R/InitErgmTerm.diversity.R new file mode 100644 index 00000000..692f8309 --- /dev/null +++ b/R/InitErgmTerm.diversity.R @@ -0,0 +1,304 @@ +#' @templateVar name nodecovrange +#' @title Range of covariate values for neighbors of a node +#' @description This term adds a single network statistic equalling +#' the sum over the nodes of the difference between the highest +#' value of a nodal covariate and its lower covariate. +#' +#' @usage +#' # binary: nodecovrange(attr) +#' +#' @template ergmTerm-attr +#' +#' @template ergmTerm-general +#' +#' @concept directed +#' @concept undirected +#' @concept quantitative nodal attribute +InitErgmTerm.nodecovrange<-function (nw, arglist, ...) { +### Check the network and arguments to make sure they are appropriate. + a <- check.ErgmTerm(nw, arglist, directed=NULL, bipartite=NULL, + varnames = c("attr"), + vartypes = c(ERGM_VATTR_SPEC), + defaultvalues = list(NULL), + required = c(TRUE)) +### Process the arguments + nodecov <- ergm_get_vattr(a$attr, nw, accept="numeric") + coef.names <- nodecov_names(nodecov, "nodecovrange") + list(name="nodecovrange", coef.names=coef.names, inputs=c(nodecov)) +} + + +#' @templateVar name nodeocovrange +#' @title Range of covariate values for out-neighbors of a node +#' +#' @usage +#' # binary: nodeocovrange(attr) +#' +#' @inherit nodecovrange-ergmTerm +#' @template ergmTerm-attr +#' +#' @template ergmTerm-general +#' +#' @concept directed +#' @concept quantitative nodal attribute +InitErgmTerm.nodeocovrange<-function (nw, arglist, ...) { +### Check the network and arguments to make sure they are appropriate. + a <- check.ErgmTerm(nw, arglist, directed=TRUE, bipartite=NULL, + varnames = c("attr"), + vartypes = c(ERGM_VATTR_SPEC), + defaultvalues = list(NULL), + required = c(TRUE)) +### Process the arguments + nodecov <- ergm_get_vattr(a$attr, nw, accept="numeric") + coef.names <- nodecov_names(nodecov, "nodeocovrange") + list(name="nodeocovrange", coef.names=coef.names, inputs=c(nodecov)) +} + + +#' @templateVar name nodeicovrange +#' @title Range of covariate values for in-neighbors of a node +#' +#' @usage +#' # binary: nodeicovrange(attr) +#' +#' @inherit nodecovrange-ergmTerm +#' @template ergmTerm-attr +#' +#' @template ergmTerm-general +#' +#' @concept directed +#' @concept quantitative nodal attribute +InitErgmTerm.nodeicovrange<-function (nw, arglist, ...) { +### Check the network and arguments to make sure they are appropriate. + a <- check.ErgmTerm(nw, arglist, directed=TRUE, bipartite=NULL, + varnames = c("attr"), + vartypes = c(ERGM_VATTR_SPEC), + defaultvalues = list(NULL), + required = c(TRUE)) +### Process the arguments + nodecov <- ergm_get_vattr(a$attr, nw, accept="numeric") + coef.names <- nodecov_names(nodecov, "nodeicovrange") + list(name="nodeicovrange", coef.names=coef.names, inputs=c(nodecov)) +} + + +#' @templateVar name b1covrange +#' @title Range of covariate values for neighbors of a mode-1 node +#' +#' @usage +#' # binary: nodecovrange(attr) +#' +#' @inherit nodecovrange-ergmTerm +#' @template ergmTerm-attr +#' +#' @template ergmTerm-general +#' +#' @concept bipartite +#' @concept quantitative nodal attribute +InitErgmTerm.b1covrange<-function (nw, arglist, ...) { +### Check the network and arguments to make sure they are appropriate. + a <- check.ErgmTerm(nw, arglist, directed=NULL, bipartite=TRUE, + varnames = c("attr"), + vartypes = c(ERGM_VATTR_SPEC), + defaultvalues = list(NULL), + required = c(TRUE)) +### Process the arguments + nodecov <- ergm_get_vattr(a$attr, nw, accept="numeric", bip="b2") + coef.names <- nodecov_names(nodecov, "b1covrange") + list(name="b1covrange", coef.names=coef.names, inputs=c(nodecov)) +} + + + +#' @templateVar name b2covrange +#' @title Range of covariate values for neighbors of a mode-2 node +#' +#' @usage +#' # binary: nodecovrange(attr) +#' +#' @inherit nodecovrange-ergmTerm +#' @template ergmTerm-attr +#' +#' @template ergmTerm-general +#' +#' @concept bipartite +#' @concept quantitative nodal attribute +InitErgmTerm.b2covrange<-function (nw, arglist, ...) { +### Check the network and arguments to make sure they are appropriate. + a <- check.ErgmTerm(nw, arglist, directed=NULL, bipartite=TRUE, + varnames = c("attr"), + vartypes = c(ERGM_VATTR_SPEC), + defaultvalues = list(NULL), + required = c(TRUE)) +### Process the arguments + nodecov <- ergm_get_vattr(a$attr, nw, accept="numeric", bip="b1") + coef.names <- nodecov_names(nodecov, "b2covrange") + list(name="nodeicovrange", coef.names=coef.names, inputs=c(nodecov)) +} + + + +.nodefactordistinct_impl <- function(deg, dir, bip, nw, arglist, ..., degname=deg){ + a <- check.ErgmTerm(nw, arglist, directed=dir, bipartite=bip, + varnames = c("attr", "levels"), + vartypes = c(ERGM_VATTR_SPEC, ERGM_LEVELS_SPEC), + defaultvalues = list(NULL, NULL), + required = c(TRUE, FALSE)) + + attr <- a$attr + levels <- a$levels + + nodecov <- if(NVL(bip, FALSE)) ergm_get_vattr(attr, nw, bip = c(b1="b2",b2="b1")[deg]) else ergm_get_vattr(attr, nw) + attrname <- attr(nodecov, "name") + u <- ergm_attr_levels(levels, nodecov, nw, levels = sort(unique(nodecov))) + + if (length(u)==0) { # Get outta here! (can happen if user passes attribute with one value) + return() + } + # Recode to numeric + nodepos <- match(nodecov,u,nomatch=0) + ### Construct the list to return + inputs <- c(max(nodepos), nodepos) + list(name=paste0(degname, "factordistinct"), #required + coef.names = paste(paste0(deg, "factordistinct"), paste(attrname,collapse="."), sep="."), #required + iinputs = inputs, + minval = 0 + ) +} + +#' @templateVar name nodefactordistinct +#' @title Number of distinct neighbor types +#' @description This term adds a single network statistic to the +#' model, counting, for each node, the number of distinct values of +#' the attribute found among its neighbors. +#' +#' @usage +#' # binary: nodefactordistinct(attr, levels=TRUE) +#' +#' @template ergmTerm-attr +#' @templateVar explain this optional argument controls which levels of the attribute +#' should be included and which should be excluded. +#' @template ergmTerm-levels-doco +#' +#' @template ergmTerm-general +#' +#' @concept directed +#' @concept undirected +#' @concept categorical nodal attribute +InitErgmTerm.nodefactordistinct<-function (nw, arglist, ...) { + a <- check.ErgmTerm(nw, arglist, + varnames = c("attr", "levels"), + vartypes = c(ERGM_VATTR_SPEC, ERGM_LEVELS_SPEC), + defaultvalues = list(NULL, NULL), + required = c(TRUE, FALSE), + dep.inform = list(FALSE, FALSE)) + .nodefactordistinct_impl("node", NULL, NULL, nw, arglist) +} + + +#' @templateVar name nodeofactordistinct +#' @title Number of distinct out-neighbor types +#' +#' @usage +#' # binary: nodeofactordistinct(attr, levels=TRUE) +#' +#' @inherit nodefactordistinct-ergmTerm +#' @template ergmTerm-attr +#' @templateVar explain this optional argument controls which levels of the attribute +#' should be included and which should be excluded. +#' @template ergmTerm-levels-doco +#' +#' @template ergmTerm-general +#' +#' @concept directed +#' @concept categorical nodal attribute +InitErgmTerm.nodeofactordistinct<-function (nw, arglist, ...) { + a <- check.ErgmTerm(nw, arglist, + varnames = c("attr", "levels"), + vartypes = c(ERGM_VATTR_SPEC, ERGM_LEVELS_SPEC), + defaultvalues = list(NULL, NULL), + required = c(TRUE, FALSE), + dep.inform = list(FALSE, FALSE)) + .nodefactordistinct_impl("nodeo", TRUE, NULL, nw, arglist) +} + + +#' @templateVar name nodeifactordistinct +#' @title Number of distinct in-neighbor types +#' +#' @usage +#' # binary: nodeifactordistinct(attr, levels=TRUE) +#' +#' @inherit nodefactordistinct-ergmTerm +#' @template ergmTerm-attr +#' @templateVar explain this optional argument controls which levels of the attribute +#' should be included and which should be excluded. +#' @template ergmTerm-levels-doco +#' +#' @template ergmTerm-general +#' +#' @concept directed +#' @concept categorical nodal attribute +InitErgmTerm.nodeifactordistinct<-function (nw, arglist, ...) { + a <- check.ErgmTerm(nw, arglist, + varnames = c("attr", "levels"), + vartypes = c(ERGM_VATTR_SPEC, ERGM_LEVELS_SPEC), + defaultvalues = list(NULL, NULL), + required = c(TRUE, FALSE), + dep.inform = list(FALSE, FALSE)) + .nodefactordistinct_impl("nodei", TRUE, NULL, nw, arglist) +} + + +#' @templateVar name b1factordistinct +#' @title Number of distinct neighbor types for the first node +#' +#' @usage +#' # binary: b1factordistinct(attr, levels=TRUE) +#' +#' @inherit nodefactordistinct-ergmTerm +#' @template ergmTerm-attr +#' @templateVar explain this optional argument controls which levels of the attribute +#' should be included and which should be excluded. +#' @template ergmTerm-levels-doco +#' +#' @template ergmTerm-general +#' +#' @concept bipartite +#' @concept categorical nodal attribute +InitErgmTerm.b1factordistinct<-function (nw, arglist, ...) { + a <- check.ErgmTerm(nw, arglist, + varnames = c("attr", "levels"), + vartypes = c(ERGM_VATTR_SPEC, ERGM_LEVELS_SPEC), + defaultvalues = list(NULL, NULL), + required = c(TRUE, FALSE), + dep.inform = list(FALSE, FALSE)) + .nodefactordistinct_impl("b1", NULL, TRUE, nw, arglist) +} + + +#' @templateVar name b2factordistinct +#' @title Number of distinct neighbor types for the second mode +#' +#' @usage +#' # binary: b2factordistinct(attr, levels=TRUE) +#' +#' @inherit nodefactordistinct-ergmTerm +#' @template ergmTerm-attr +#' @templateVar explain this optional argument controls which levels of the attribute +#' should be included and which should be excluded. +#' @template ergmTerm-levels-doco +#' +#' @template ergmTerm-general +#' +#' @concept bipartite +#' @concept categorical nodal attribute +InitErgmTerm.b2factordistinct<-function (nw, arglist, ...) { + a <- check.ErgmTerm(nw, arglist, + varnames = c("attr", "levels"), + vartypes = c(ERGM_VATTR_SPEC, ERGM_LEVELS_SPEC), + defaultvalues = list(NULL, NULL), + required = c(TRUE, FALSE), + dep.inform = list(FALSE, FALSE)) + .nodefactordistinct_impl("b2", NULL, TRUE, nw, arglist) +} diff --git a/man/b1covrange-ergmTerm-24a903d2.Rd b/man/b1covrange-ergmTerm-24a903d2.Rd new file mode 100644 index 00000000..5e9e57af --- /dev/null +++ b/man/b1covrange-ergmTerm-24a903d2.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/InitErgmTerm.diversity.R +\name{b1covrange-ergmTerm} +\alias{b1covrange-ergmTerm} +\alias{InitErgmTerm.b1covrange} +\title{Range of covariate values for neighbors of a mode-1 node} +\usage{ +# binary: nodecovrange(attr) +} +\arguments{ +\item{attr}{a vertex attribute specification (see Specifying Vertex attributes and Levels (\code{?nodal_attributes}) for details.)} +} +\description{ +This term adds a single network statistic equalling +the sum over the nodes of the difference between the highest +value of a nodal covariate and its lower covariate. +} +\seealso{ +\code{\link{ergmTerm}} for index of model terms currently visible to the package. + +\Sexpr[results=rd,stage=render]{ergm:::.formatTermKeywords("ergmTerm", "b1covrange", "subsection")} +} +\concept{bipartite} +\concept{quantitative nodal attribute} diff --git a/man/b1degm1lfactorial-ergmTerm-268d1fe0.Rd b/man/b1degm1lfactorial-ergmTerm-268d1fe0.Rd new file mode 100644 index 00000000..351352c9 --- /dev/null +++ b/man/b1degm1lfactorial-ergmTerm-268d1fe0.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/InitErgmTerm.degfactorial.R +\name{b1degm1lfactorial-ergmTerm} +\alias{b1degm1lfactorial-ergmTerm} +\alias{InitErgmTerm.b1degm1lfactorial} +\title{Sum of log-factorials of degrees of Mode-1 non-isolates minus 1} +\usage{ +# binary: b1degm1lfactorial +} +\description{ +This term adds one network statistic to the model, +equalling \eqn{\sum_{i=1}^b \mathbb{I}(d_i>0) \log(d_i - 1)!}. +} +\seealso{ +\code{\link{ergmTerm}} for index of model terms currently visible to the package. + +\Sexpr[results=rd,stage=render]{ergm:::.formatTermKeywords("ergmTerm", "b1degm1lfactorial", "subsection")} +} +\concept{bipartite} +\concept{undirected} diff --git a/man/b1factordistinct-ergmTerm-f897b95c.Rd b/man/b1factordistinct-ergmTerm-f897b95c.Rd new file mode 100644 index 00000000..940e3f37 --- /dev/null +++ b/man/b1factordistinct-ergmTerm-f897b95c.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/InitErgmTerm.diversity.R +\name{b1factordistinct-ergmTerm} +\alias{b1factordistinct-ergmTerm} +\alias{InitErgmTerm.b1factordistinct} +\title{Number of distinct neighbor types for the first node} +\usage{ +# binary: b1factordistinct(attr, levels=TRUE) +} +\arguments{ +\item{attr}{a vertex attribute specification (see Specifying Vertex attributes and Levels (\code{?nodal_attributes}) for details.)} + +\item{levels}{this optional argument controls which levels of the attribute +attributes and Levels (\code{\link[=nodal_attributes]{?nodal_attributes}}) for details.)} +} +\description{ +This term adds a single network statistic to the +model, counting, for each node, the number of distinct values of +the attribute found among its neighbors. +} +\seealso{ +\code{\link{ergmTerm}} for index of model terms currently visible to the package. + +\Sexpr[results=rd,stage=render]{ergm:::.formatTermKeywords("ergmTerm", "b1factordistinct", "subsection")} +} +\concept{bipartite} +\concept{categorical nodal attribute} diff --git a/man/b2covrange-ergmTerm-5e2bcc86.Rd b/man/b2covrange-ergmTerm-5e2bcc86.Rd new file mode 100644 index 00000000..7852704c --- /dev/null +++ b/man/b2covrange-ergmTerm-5e2bcc86.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/InitErgmTerm.diversity.R +\name{b2covrange-ergmTerm} +\alias{b2covrange-ergmTerm} +\alias{InitErgmTerm.b2covrange} +\title{Range of covariate values for neighbors of a mode-2 node} +\usage{ +# binary: nodecovrange(attr) +} +\arguments{ +\item{attr}{a vertex attribute specification (see Specifying Vertex attributes and Levels (\code{?nodal_attributes}) for details.)} +} +\description{ +This term adds a single network statistic equalling +the sum over the nodes of the difference between the highest +value of a nodal covariate and its lower covariate. +} +\seealso{ +\code{\link{ergmTerm}} for index of model terms currently visible to the package. + +\Sexpr[results=rd,stage=render]{ergm:::.formatTermKeywords("ergmTerm", "b2covrange", "subsection")} +} +\concept{bipartite} +\concept{quantitative nodal attribute} diff --git a/man/b2degm1lfactorial-ergmTerm-134e4482.Rd b/man/b2degm1lfactorial-ergmTerm-134e4482.Rd new file mode 100644 index 00000000..26dffe27 --- /dev/null +++ b/man/b2degm1lfactorial-ergmTerm-134e4482.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/InitErgmTerm.degfactorial.R +\name{b2degm1lfactorial-ergmTerm} +\alias{b2degm1lfactorial-ergmTerm} +\alias{InitErgmTerm.b2degm1lfactorial} +\title{Sum of log-factorials of degrees of Mode-2 non-isolates minus 1} +\usage{ +# binary: b2degm1lfactorial +} +\description{ +This term adds one network statistic to the model, +equalling \eqn{\sum_{i=b+1}^n \mathbb{I}(d_i>0) \log(d_i - 1)!}. +} +\seealso{ +\code{\link{ergmTerm}} for index of model terms currently visible to the package. + +\Sexpr[results=rd,stage=render]{ergm:::.formatTermKeywords("ergmTerm", "b2degm1lfactorial", "subsection")} +} +\concept{bipartite} +\concept{undirected} diff --git a/man/b2factordistinct-ergmTerm-076e6026.Rd b/man/b2factordistinct-ergmTerm-076e6026.Rd new file mode 100644 index 00000000..345dfbdb --- /dev/null +++ b/man/b2factordistinct-ergmTerm-076e6026.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/InitErgmTerm.diversity.R +\name{b2factordistinct-ergmTerm} +\alias{b2factordistinct-ergmTerm} +\alias{InitErgmTerm.b2factordistinct} +\title{Number of distinct neighbor types for the second mode} +\usage{ +# binary: b2factordistinct(attr, levels=TRUE) +} +\arguments{ +\item{attr}{a vertex attribute specification (see Specifying Vertex attributes and Levels (\code{?nodal_attributes}) for details.)} + +\item{levels}{this optional argument controls which levels of the attribute +attributes and Levels (\code{\link[=nodal_attributes]{?nodal_attributes}}) for details.)} +} +\description{ +This term adds a single network statistic to the +model, counting, for each node, the number of distinct values of +the attribute found among its neighbors. +} +\seealso{ +\code{\link{ergmTerm}} for index of model terms currently visible to the package. + +\Sexpr[results=rd,stage=render]{ergm:::.formatTermKeywords("ergmTerm", "b2factordistinct", "subsection")} +} +\concept{bipartite} +\concept{categorical nodal attribute} diff --git a/man/degm1lfactorial-ergmTerm-0f187aa0.Rd b/man/degm1lfactorial-ergmTerm-0f187aa0.Rd new file mode 100644 index 00000000..0cfe96b7 --- /dev/null +++ b/man/degm1lfactorial-ergmTerm-0f187aa0.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/InitErgmTerm.degfactorial.R +\name{degm1lfactorial-ergmTerm} +\alias{degm1lfactorial-ergmTerm} +\alias{InitErgmTerm.degm1lfactorial} +\title{Sum of log-factorials of degrees of non-isolates minus 1} +\usage{ +# binary: degm1lfactorial +} +\description{ +This term adds one network statistic to the model, +equalling \eqn{\sum_{i=1}^n \mathbb{I}(d_i>0) \log(d_i - 1)!}. +} +\seealso{ +\code{\link{ergmTerm}} for index of model terms currently visible to the package. + +\Sexpr[results=rd,stage=render]{ergm:::.formatTermKeywords("ergmTerm", "degm1lfactorial", "subsection")} +} +\concept{undirected} diff --git a/man/idegm1lfactorial-ergmTerm-4be755fd.Rd b/man/idegm1lfactorial-ergmTerm-4be755fd.Rd new file mode 100644 index 00000000..a325e9ca --- /dev/null +++ b/man/idegm1lfactorial-ergmTerm-4be755fd.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/InitErgmTerm.degfactorial.R +\name{idegm1lfactorial-ergmTerm} +\alias{idegm1lfactorial-ergmTerm} +\alias{InitErgmTerm.idegm1lfactorial} +\title{Sum of log-factorials of indegrees of non-in-isolates minus 1} +\usage{ +# binary: idegm1lfactorial +} +\description{ +This term adds one network statistic to the model, +equalling \eqn{\sum_{i=1}^n \mathbb{I}(id_i>0) \log(id_i - 1)!}. +} +\seealso{ +\code{\link{ergmTerm}} for index of model terms currently visible to the package. + +\Sexpr[results=rd,stage=render]{ergm:::.formatTermKeywords("ergmTerm", "idegm1lfactorial", "subsection")} +} +\concept{bipartite} +\concept{undirected} diff --git a/man/nodecovrange-ergmTerm-7ae91499.Rd b/man/nodecovrange-ergmTerm-7ae91499.Rd new file mode 100644 index 00000000..84bb2392 --- /dev/null +++ b/man/nodecovrange-ergmTerm-7ae91499.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/InitErgmTerm.diversity.R +\name{nodecovrange-ergmTerm} +\alias{nodecovrange-ergmTerm} +\alias{InitErgmTerm.nodecovrange} +\title{Range of covariate values for neighbors of a node} +\usage{ +# binary: nodecovrange(attr) +} +\arguments{ +\item{attr}{a vertex attribute specification (see Specifying Vertex attributes and Levels (\code{?nodal_attributes}) for details.)} +} +\description{ +This term adds a single network statistic equalling +the sum over the nodes of the difference between the highest +value of a nodal covariate and its lower covariate. +} +\seealso{ +\code{\link{ergmTerm}} for index of model terms currently visible to the package. + +\Sexpr[results=rd,stage=render]{ergm:::.formatTermKeywords("ergmTerm", "nodecovrange", "subsection")} +} +\concept{directed} +\concept{quantitative nodal attribute} +\concept{undirected} diff --git a/man/nodefactordistinct-ergmTerm-3445048c.Rd b/man/nodefactordistinct-ergmTerm-3445048c.Rd new file mode 100644 index 00000000..858e9651 --- /dev/null +++ b/man/nodefactordistinct-ergmTerm-3445048c.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/InitErgmTerm.diversity.R +\name{nodefactordistinct-ergmTerm} +\alias{nodefactordistinct-ergmTerm} +\alias{InitErgmTerm.nodefactordistinct} +\title{Number of distinct neighbor types} +\usage{ +# binary: nodefactordistinct(attr, levels=TRUE) +} +\arguments{ +\item{attr}{a vertex attribute specification (see Specifying Vertex attributes and Levels (\code{?nodal_attributes}) for details.)} + +\item{levels}{this optional argument controls which levels of the attribute +attributes and Levels (\code{\link[=nodal_attributes]{?nodal_attributes}}) for details.)} +} +\description{ +This term adds a single network statistic to the +model, counting, for each node, the number of distinct values of +the attribute found among its neighbors. +} +\seealso{ +\code{\link{ergmTerm}} for index of model terms currently visible to the package. + +\Sexpr[results=rd,stage=render]{ergm:::.formatTermKeywords("ergmTerm", "nodefactordistinct", "subsection")} +} +\concept{categorical nodal attribute} +\concept{directed} +\concept{undirected} diff --git a/man/nodeicovrange-ergmTerm-29a8edd7.Rd b/man/nodeicovrange-ergmTerm-29a8edd7.Rd new file mode 100644 index 00000000..12161e88 --- /dev/null +++ b/man/nodeicovrange-ergmTerm-29a8edd7.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/InitErgmTerm.diversity.R +\name{nodeicovrange-ergmTerm} +\alias{nodeicovrange-ergmTerm} +\alias{InitErgmTerm.nodeicovrange} +\title{Range of covariate values for in-neighbors of a node} +\usage{ +# binary: nodeicovrange(attr) +} +\arguments{ +\item{attr}{a vertex attribute specification (see Specifying Vertex attributes and Levels (\code{?nodal_attributes}) for details.)} +} +\description{ +This term adds a single network statistic equalling +the sum over the nodes of the difference between the highest +value of a nodal covariate and its lower covariate. +} +\seealso{ +\code{\link{ergmTerm}} for index of model terms currently visible to the package. + +\Sexpr[results=rd,stage=render]{ergm:::.formatTermKeywords("ergmTerm", "nodeicovrange", "subsection")} +} +\concept{directed} +\concept{quantitative nodal attribute} diff --git a/man/nodeifactordistinct-ergmTerm-25cbd312.Rd b/man/nodeifactordistinct-ergmTerm-25cbd312.Rd new file mode 100644 index 00000000..9b83912e --- /dev/null +++ b/man/nodeifactordistinct-ergmTerm-25cbd312.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/InitErgmTerm.diversity.R +\name{nodeifactordistinct-ergmTerm} +\alias{nodeifactordistinct-ergmTerm} +\alias{InitErgmTerm.nodeifactordistinct} +\title{Number of distinct in-neighbor types} +\usage{ +# binary: nodeifactordistinct(attr, levels=TRUE) +} +\arguments{ +\item{attr}{a vertex attribute specification (see Specifying Vertex attributes and Levels (\code{?nodal_attributes}) for details.)} + +\item{levels}{this optional argument controls which levels of the attribute +attributes and Levels (\code{\link[=nodal_attributes]{?nodal_attributes}}) for details.)} +} +\description{ +This term adds a single network statistic to the +model, counting, for each node, the number of distinct values of +the attribute found among its neighbors. +} +\seealso{ +\code{\link{ergmTerm}} for index of model terms currently visible to the package. + +\Sexpr[results=rd,stage=render]{ergm:::.formatTermKeywords("ergmTerm", "nodeifactordistinct", "subsection")} +} +\concept{categorical nodal attribute} +\concept{directed} diff --git a/man/nodeocovrange-ergmTerm-382e45c5.Rd b/man/nodeocovrange-ergmTerm-382e45c5.Rd new file mode 100644 index 00000000..b4373ea4 --- /dev/null +++ b/man/nodeocovrange-ergmTerm-382e45c5.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/InitErgmTerm.diversity.R +\name{nodeocovrange-ergmTerm} +\alias{nodeocovrange-ergmTerm} +\alias{InitErgmTerm.nodeocovrange} +\title{Range of covariate values for out-neighbors of a node} +\usage{ +# binary: nodeocovrange(attr) +} +\arguments{ +\item{attr}{a vertex attribute specification (see Specifying Vertex attributes and Levels (\code{?nodal_attributes}) for details.)} +} +\description{ +This term adds a single network statistic equalling +the sum over the nodes of the difference between the highest +value of a nodal covariate and its lower covariate. +} +\seealso{ +\code{\link{ergmTerm}} for index of model terms currently visible to the package. + +\Sexpr[results=rd,stage=render]{ergm:::.formatTermKeywords("ergmTerm", "nodeocovrange", "subsection")} +} +\concept{directed} +\concept{quantitative nodal attribute} diff --git a/man/nodeofactordistinct-ergmTerm-f159e5dc.Rd b/man/nodeofactordistinct-ergmTerm-f159e5dc.Rd new file mode 100644 index 00000000..c8dccc2b --- /dev/null +++ b/man/nodeofactordistinct-ergmTerm-f159e5dc.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/InitErgmTerm.diversity.R +\name{nodeofactordistinct-ergmTerm} +\alias{nodeofactordistinct-ergmTerm} +\alias{InitErgmTerm.nodeofactordistinct} +\title{Number of distinct out-neighbor types} +\usage{ +# binary: nodeofactordistinct(attr, levels=TRUE) +} +\arguments{ +\item{attr}{a vertex attribute specification (see Specifying Vertex attributes and Levels (\code{?nodal_attributes}) for details.)} + +\item{levels}{this optional argument controls which levels of the attribute +attributes and Levels (\code{\link[=nodal_attributes]{?nodal_attributes}}) for details.)} +} +\description{ +This term adds a single network statistic to the +model, counting, for each node, the number of distinct values of +the attribute found among its neighbors. +} +\seealso{ +\code{\link{ergmTerm}} for index of model terms currently visible to the package. + +\Sexpr[results=rd,stage=render]{ergm:::.formatTermKeywords("ergmTerm", "nodeofactordistinct", "subsection")} +} +\concept{categorical nodal attribute} +\concept{directed} diff --git a/man/odegm1lfactorial-ergmTerm-b8eb44b3.Rd b/man/odegm1lfactorial-ergmTerm-b8eb44b3.Rd new file mode 100644 index 00000000..dad04072 --- /dev/null +++ b/man/odegm1lfactorial-ergmTerm-b8eb44b3.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/InitErgmTerm.degfactorial.R +\name{odegm1lfactorial-ergmTerm} +\alias{odegm1lfactorial-ergmTerm} +\alias{InitErgmTerm.odegm1lfactorial} +\title{Sum of log-factorials of outdegrees of non-out-isolates minus 1} +\usage{ +# binary: odegm1lfactorial +} +\description{ +This term adds one network statistic to the model, +equalling \eqn{\sum_{i=1}^n \mathbb{I}(od_i>0) \log(od_i - 1)!}. +} +\seealso{ +\code{\link{ergmTerm}} for index of model terms currently visible to the package. + +\Sexpr[results=rd,stage=render]{ergm:::.formatTermKeywords("ergmTerm", "odegm1lfactorial", "subsection")} +} +\concept{bipartite} +\concept{undirected} diff --git a/src/changestats_degfactorial.c b/src/changestats_degfactorial.c new file mode 100644 index 00000000..e07d8dcd --- /dev/null +++ b/src/changestats_degfactorial.c @@ -0,0 +1,20 @@ +#include "ergm_changestat.h" +#include "ergm_storage.h" + +#define mk_c_sum_lfactorial_degreem1(_LABEL_, _OUT_, _IN_) \ + \ + C_CHANGESTAT_FN(c_sum_lfactorial_ ## _LABEL_ ## degreem1){ \ + int echange=edgestate ? -1:+1; \ + \ + Vertex otd = 0, ntd = 0, ohd = 0, nhd = 0; \ + \ + if(_OUT_){otd = OUT_DEG[tail] + ( _IN_ ? IN_DEG[tail] : 0); ntd = otd + echange;} \ + if(_IN_){ohd = ( _OUT_ ? OUT_DEG[head] : 0) + IN_DEG[head]; nhd = ohd + echange;} \ + \ + CHANGE_STAT[0] += (ntd?lgammafn(ntd):0) - (otd?lgammafn(otd):0) \ + + (nhd?lgammafn(nhd):0) - (ohd?lgammafn(ohd):0); \ + } + +mk_c_sum_lfactorial_degreem1(, TRUE, TRUE); +mk_c_sum_lfactorial_degreem1(o, TRUE, FALSE); +mk_c_sum_lfactorial_degreem1(i, FALSE, TRUE); diff --git a/src/changestats_diversity.c b/src/changestats_diversity.c new file mode 100644 index 00000000..22bf47da --- /dev/null +++ b/src/changestats_diversity.c @@ -0,0 +1,100 @@ +#include "ergm_changestat.h" +#include "ergm_storage.h" + +#define mk_c_nodecovrange(_LABEL_, _OUT_, _IN_, _BSHIFT_) \ + C_CHANGESTAT_FN(c_ ## _LABEL_ ## covrange) { \ + if( _OUT_ ) { \ + double oldmin = R_PosInf, oldmax = R_NegInf, newmin = R_PosInf, newmax = R_NegInf; \ + \ + EXEC_THROUGH_OUTEDGES(tail, e, u, { \ + oldmin = MIN(oldmin, INPUT_PARAM[u-1 _BSHIFT_]); \ + oldmax = MAX(oldmax, INPUT_PARAM[u-1 _BSHIFT_]); \ + \ + if(!edgestate || u!=head){ \ + newmin = MIN(newmin, INPUT_PARAM[u-1 _BSHIFT_]); \ + newmax = MAX(newmax, INPUT_PARAM[u-1 _BSHIFT_]); \ + } \ + }); \ + \ + if(!edgestate){ \ + newmin = MIN(newmin, INPUT_PARAM[head-1 _BSHIFT_]); \ + newmax = MAX(newmax, INPUT_PARAM[head-1 _BSHIFT_]); \ + } \ + \ + CHANGE_STAT[0] += (isinf(newmax) ? 0 : newmax-newmin) - (isinf(oldmax) ? 0 : oldmax-oldmin); \ + } \ + \ + if( _IN_ ) { \ + double oldmin = R_PosInf, oldmax = R_NegInf, newmin = R_PosInf, newmax = R_NegInf; \ + \ + EXEC_THROUGH_INEDGES(head, e, u, { \ + oldmin = MIN(oldmin, INPUT_PARAM[u-1]); \ + oldmax = MAX(oldmax, INPUT_PARAM[u-1]); \ + \ + if(!edgestate || u!=tail){ \ + newmin = MIN(newmin, INPUT_PARAM[u-1]); \ + newmax = MAX(newmax, INPUT_PARAM[u-1]); \ + } \ + }); \ + \ + if(!edgestate){ \ + newmin = MIN(newmin, INPUT_PARAM[tail-1]); \ + newmax = MAX(newmax, INPUT_PARAM[tail-1]); \ + } \ + \ + CHANGE_STAT[0] += (isinf(newmax) ? 0 : newmax-newmin) - (isinf(oldmax) ? 0 : oldmax-oldmin); \ + } \ + } + +mk_c_nodecovrange(node, TRUE, TRUE,) +mk_c_nodecovrange(nodeo, TRUE, FALSE,) +mk_c_nodecovrange(nodei, FALSE, TRUE,) +mk_c_nodecovrange(b1, TRUE, FALSE, - BIPARTITE) + + +#define mk_nodefactordistinct(_LABEL_, _EFF_NODES_, _OUT_, _IN_, _BSHIFT_) \ + \ + I_CHANGESTAT_FN(i_ ## _LABEL_ ## factordistinct) { \ + unsigned int ncats = IINPUT_PARAM[0]; \ + \ + ALLOC_STORAGE(ncats*(_EFF_NODES_), unsigned int, freqs); \ + \ + EXEC_THROUGH_NET_EDGES(tail, head, e, { \ + if(_OUT_ && IINPUT_PARAM[head _BSHIFT_]) freqs[(tail-1)*ncats + IINPUT_PARAM[head _BSHIFT_] - 1]++; \ + if(_IN_ && IINPUT_PARAM[tail]) freqs[(head-1 _BSHIFT_)*ncats + IINPUT_PARAM[tail] - 1]++; \ + }); \ + } \ + \ + C_CHANGESTAT_FN(c_ ## _LABEL_ ## factordistinct) { \ + unsigned int ncats = IINPUT_PARAM[0]; \ + GET_STORAGE(unsigned int, freqs); \ + int change = edgestate ? -1 : +1; \ + if(_OUT_ && IINPUT_PARAM[head _BSHIFT_]) { \ + unsigned int oldfreq = freqs[(tail-1)*ncats + IINPUT_PARAM[head _BSHIFT_] - 1]; \ + unsigned int newfreq = oldfreq + change; \ + CHANGE_STAT[0] += (newfreq!=0) - (oldfreq!=0); \ + } \ + \ + if(_IN_ && IINPUT_PARAM[tail]) { \ + unsigned int oldfreq = freqs[(head-1 _BSHIFT_)*ncats + IINPUT_PARAM[tail] - 1]; \ + unsigned int newfreq = oldfreq + change; \ + CHANGE_STAT[0] += (newfreq!=0) - (oldfreq!=0); \ + } \ + } \ + \ + \ + U_CHANGESTAT_FN(u_ ## _LABEL_ ## factordistinct) { \ + unsigned int ncats = IINPUT_PARAM[0]; \ + GET_STORAGE(unsigned int, freqs); \ + int change = edgestate ? -1 : +1; \ + if(_OUT_ && IINPUT_PARAM[head _BSHIFT_]) \ + freqs[(tail-1)*ncats + IINPUT_PARAM[head _BSHIFT_] - 1] += change; \ + if(_IN_ && IINPUT_PARAM[tail]) \ + freqs[(head-1 _BSHIFT_)*ncats + IINPUT_PARAM[tail] - 1] += change; \ + } + +mk_nodefactordistinct(node, N_NODES, TRUE, TRUE,) +mk_nodefactordistinct(nodeo, N_NODES, TRUE, FALSE,) +mk_nodefactordistinct(nodei, N_NODES, FALSE, TRUE,) +mk_nodefactordistinct(b1, BIPARTITE, TRUE, FALSE, - BIPARTITE) +mk_nodefactordistinct(b2, N_NODES-BIPARTITE, FALSE, TRUE, - BIPARTITE) diff --git a/tests/testthat/test-ergm-term-doc.R b/tests/testthat/test-ergm-term-doc.R index 35ae473a..decaa8e3 100644 --- a/tests/testthat/test-ergm-term-doc.R +++ b/tests/testthat/test-ergm-term-doc.R @@ -32,14 +32,14 @@ test_that("test search ergm term", { # search using a bipartite net as a template myNet<-network.initialize(5,bipartite=3,directed=FALSE) - expect_equal(length(search.ergmTerms(net=myNet)), 31) + expect_equal(length(search.ergmTerms(net=myNet)), 35) - expect_equal(length(search.ergmTerms(keywords = 'bipartite', packages='ergm')), 32) + expect_equal(length(search.ergmTerms(keywords = 'bipartite', packages='ergm')), 40) expect_gt(length(search.ergmTerms(name = 'b2factor', packages='ergm')), 0) expect_equal(length(search.ergmTerms(name = 'b3factor', packages='ergm')), 0) - expect_equal(length(search.ergmTerms(keywords = 'bipartite', packages='ergm')), 32) + expect_equal(length(search.ergmTerms(keywords = 'bipartite', packages='ergm')), 40) ## expect_gt(length(search.ergmTerms(keywords = 'valued')), 44) expect_equal(length(search.ergmTerms(keywords = 'valued', packages='ergm')), 44) diff --git a/tests/testthat/test-term-degfactorial.R b/tests/testthat/test-term-degfactorial.R new file mode 100644 index 00000000..81897bed --- /dev/null +++ b/tests/testthat/test-term-degfactorial.R @@ -0,0 +1,43 @@ +degm1lfactorial <- function(d){ + d <- d-1 + sum(lfactorial(d[d>=0])) +} + +data(florentine) + +test_that("degm1lfactorial summary", { + expect_equal(summary(flomarriage~degm1lfactorial), + degm1lfactorial(summary(flomarriage~sociality(nodes=TRUE))), + ignore_attr = TRUE) +}) + +n <- 20 +b <- 5 +nw0 <- network.initialize(n, bipartite = b, directed = FALSE) +nw1 <- simulate(nw0 ~ edges, coef = 0) + +test_that("b1degm1lfactorial summary", { + expect_equal(summary(nw1~b1degm1lfactorial), + degm1lfactorial(summary(nw1~b1sociality(nodes=TRUE))), + ignore_attr = TRUE) +}) + +test_that("b2degm1lfactorial summary", { + expect_equal(summary(nw1~b2degm1lfactorial), + degm1lfactorial(summary(nw1~b2sociality(nodes=TRUE))), + ignore_attr = TRUE) +}) + +data(sampson) + +test_that("odegm1lfactorial summary", { + expect_equal(summary(samplike~odegm1lfactorial), + degm1lfactorial(summary(samplike~sender(nodes=TRUE))), + ignore_attr = TRUE) +}) + +test_that("idegm1lfactorial summary", { + expect_equal(summary(samplike~idegm1lfactorial), + degm1lfactorial(summary(samplike~receiver(nodes=TRUE))), + ignore_attr = TRUE) +}) diff --git a/tests/testthat/test-term-diversity.R b/tests/testthat/test-term-diversity.R new file mode 100644 index 00000000..21181b2c --- /dev/null +++ b/tests/testthat/test-term-diversity.R @@ -0,0 +1,112 @@ +diversity <- function(nw, a, which = c("u", "i", "o", "1", "2"), stat = c("range", "distinct")){ + which <- match.arg(which) + stat <- match.arg(stat) + stat <- switch(stat, + range = function(x) diff(range(x, na.rm=TRUE)), + distinct = function(x) length(na.omit(unique(x)))) + + m <- as.matrix(nw) + w <- switch(which, + u =, + i =, + o = nw %v% a, + `1` = (nw %v% a)[-seq_len(nw%n%"bipartite")], + `2` = (nw %v% a)[seq_len(nw%n%"bipartite")]) + + if(which %in% c("o","1")) m <- t(m) + + r <- suppressWarnings(apply(ifelse(m, w, NA), 2, stat)) + sum(r[!is.infinite(r) & !is.na(r)]) +} + +data(florentine) + +test_that("nodecovrange summary", { + expect_equal(summary(flomarriage~nodecovrange("wealth")), + diversity(flomarriage, "wealth", "u", "range"), + ignore_attr = TRUE) +}) + +n <- 20 +b <- 5 + +nw0 <- network.initialize(n, bipartite = b, directed = FALSE) +nw0 %v% "b1" <- c(rnorm(b), rep(NA, n-b)) +nw0 %v% "b2" <- c(rep(NA, b), rnorm(n-b)) +nw1 <- simulate(nw0 ~ edges, coef = 0) + +test_that("b1covrange summary", { + expect_equal(summary(nw1~b1covrange("b2")), + diversity(nw1, "b2", "1", "range"), + ignore_attr = TRUE) +}) + +test_that("b2covrange summary", { + expect_equal(summary(nw1~b2covrange("b1")), + diversity(nw1, "b1", "2", "range"), + ignore_attr = TRUE) +}) + +data(sampson) +samplike %v% "w" <- rnorm(network.size(samplike)) + +test_that("nodeocovrange summary", { + expect_equal(summary(samplike~nodeocovrange("w")), + diversity(samplike, "w", "o", "range"), + ignore_attr = TRUE) +}) + +test_that("nodeicovrange summary", { + expect_equal(summary(samplike~nodeicovrange("w")), + diversity(samplike, "w", "i", "range"), + ignore_attr = TRUE) +}) + + +flomarriage %v% "c" <- sample.int(5, network.size(flomarriage), replace=TRUE) + +test_that("nodefactordistinct summary", { + expect_equal(summary(flomarriage~nodefactordistinct("c")), + diversity(flomarriage, "c", "u", "distinct"), + ignore_attr = TRUE) +}) + +test_that("nodeofactordistinct summary", { + expect_equal(summary(samplike~nodeofactordistinct("group")), + diversity(samplike, "group", "o", "distinct"), + ignore_attr = TRUE) +}) + +test_that("nodefactordistinct summary", { + expect_equal(summary(flomarriage~nodefactordistinct("c")), + diversity(flomarriage, "c", "u", "distinct"), + ignore_attr = TRUE) +}) + +test_that("nodeifactordistinct summary", { + expect_equal(summary(samplike~nodeifactordistinct("group")), + diversity(samplike, "group", "i", "distinct"), + ignore_attr = TRUE) +}) + + +n <- 20 +b <- 5 + +nw0 <- network.initialize(n, bipartite = b, directed = FALSE) +nw0 %v% "b1" <- c(sample.int(3, b, TRUE), rep(NA, n-b)) +nw0 %v% "b2" <- c(rep(NA, b), sample.int(3, n-b, TRUE)) +nw1 <- simulate(nw0 ~ edges, coef = 0) + + +test_that("b1factordistinct summary", { + expect_equal(summary(nw1~b1factordistinct("b2")), + diversity(nw1, "b2", "1", "distinct"), + ignore_attr = TRUE) +}) + +test_that("b2factordistinct summary", { + expect_equal(summary(nw1~b2factordistinct("b1")), + diversity(nw1, "b1", "2", "distinct"), + ignore_attr = TRUE) +})