Nothing
# File R/InitWtErgmTerm.operator.R in package ergm, part of the
# Statnet suite of packages for network analysis, https://statnet.org .
#
# This software is distributed under the GPL-3 license. It is free,
# open source, and has the attribution requirements (GPL Section 7) at
# https://statnet.org/attribution .
#
# Copyright 2003-2023 Statnet Commons
################################################################################
InitWtErgmTerm.Passthrough <- function(nw, arglist, ...){
out <- InitErgmTerm.Passthrough(nw, arglist, ...)
out$name <- "wtpassthrough_term"
out
}
#' @templateVar name B
#' @title Wrap binary terms for use in valued models
#' @description Wraps binary `ergm` terms for use in valued models, with `formula` specifying which terms
#' are to be wrapped and `form` specifying how they are to be
#' used and how the binary network they are evaluated on is to be constructed.
#'
#' @details For example, `B(~nodecov("a"), form="sum")` is equivalent to
#' `nodecov("a", form="sum")` and similarly with
#' `form="nonzero"` .
#'
#' When a valued implementation is available, it should be
#' preferred, as it is likely to be faster.
#'
#' @usage
#' # valued: B(formula, form)
#' @param formula a one-sided [ergm()]-style formula whose RHS contains the
#' binary ergm terms to be evaluated. Which terms may be used
#' depends on the argument `form`
#' @param form One of three values:
#' - `"sum"`: see section "Generalizations of
#' binary terms" in [`ergmTerm`] help; all terms in `formula` must
#' be dyad-independent.
#' - `"nonzero"`: section "Generalizations of
#' binary terms" in [`ergmTerm`] help; any binary `ergm` terms
#' may be used in `formula` .
#' - a one-sided formula value-dependent
#' network. `form` must contain one "valued" `ergm` term, with
#' the following properties:
#' - dyadic independence;
#' - dyadwise contribution of either 0 or 1; and
#' - dyadwise contribution of 0 for a 0-valued dyad.
#'
#' Formally, this means that it is expressable as
#' \deqn{g(y) = \sum_{i,j} f_{i,j}(y_{i,j}),}{sum[i,j] f[i,j] (y[i,j]),}
#' where for all \eqn{i}, \eqn{j}, and \eqn{y},
#' \eqn{f_{i,j}(y_{i,j})} is either 0 or 1 and, in particular,
#' \eqn{f_{i,j}(0)=0}{f[i,j] (0)=0}.
#'
#' Examples of such terms include `nonzero` ,
#' `ininterval()` , `atleast()` , `atmost()` ,
#' `greaterthan()` , `lessthen()` , and `equalto()` .
#'
#' Then, the value of the statistic will be the value of the
#' statistics in `formula` evaluated on a binary network that is
#' defined to have an edge if and only if the corresponding
#' dyad of the valued network adds 1 to the valued term in
#' `form` .
#'
#' @template ergmTerm-general
#'
#' @concept operator
InitWtErgmTerm.B <- function(nw, arglist, ...){
a <- check.ErgmTerm(nw, arglist,
varnames = c("formula", "form"),
vartypes = c("formula", "character,formula"),
defaultvalues = list(NULL, "sum"),
required = c(TRUE, FALSE))
form <- if(is.character(a$form)) match.arg(a$form,c("sum","nonzero"))
else a$form
nwb <- nw
nwb %ergmlhs% "response" <- NULL
m <- ergm_model(a$formula, nwb, ..., offset.decorate=FALSE)
ergm_no_ext.encode(m)
if(!is.dyad.independent(m) && form=="sum") stop("Only dyad-independent binary terms can be imported with form 'sum'.")
if(is(form, "formula")){
form.name <- despace(deparse(ult(form)))
name <- "import_binary_term_form"
auxiliaries <- trim_env(~.binary.formula.net(form),"form")
}else{
form.name <- form
name <- paste("import_binary_term",form,sep="_")
auxiliaries <- if(form=="nonzero") trim_env(~.binary.nonzero.net)
}
mw <- wrap.ergm_model(m, nwb, ergm_mk_std_op_namewrap('B', form.name))
if(form=="sum") mw$emptynwstats <- NULL
c(list(name=name,
submodel = m,
auxiliaries=auxiliaries),
mw)
}
InitWtErgmTerm..binary.nonzero.net <- function(nw, arglist, ...){
a <- check.ErgmTerm(nw, arglist,
varnames = c(),
vartypes = c(),
defaultvalues = list(),
required = c())
list(name="_binary_nonzero_net", depenence=FALSE)
}
InitWtErgmTerm..binary.formula.net <- function(nw, arglist, ...){
a <- check.ErgmTerm(nw, arglist,
varnames = c("formula"),
vartypes = c("formula"),
defaultvalues = list(NULL),
required = c(TRUE))
m <- ergm_model(a$formula, nw, ..., offset.decorate=FALSE)
if(!is.dyad.independent(m) || nparam(m)!=1) stop("The binary test formula must be dyad-independent and have exactly one statistc.")
nw[,] <- FALSE
gs <- summary(m, nw)
if(gs!=0) stop("At this time, the binary test term must have the property that its dyadwise components are 0 for 0-valued relations. This limitation may be removed in the future.")
c(list(name="_binary_formula_net", submodel=m, depenence=FALSE),
ergm_propagate_ext.encode(m),
wrap.ergm_model(m, nw, NULL))
}
# Arguments and outputs are identical to the binary version, except for the C routine names.
#' @templateVar name Sum
#' @template ergmTerm-rdname
#' @usage
#' # valued: Sum(formulas, label)
InitWtErgmTerm.Sum <- function(...){
# Rename the function to avoid the extra nesting level in the
# diagnostic messages.
f <- InitErgmTerm.Sum
term <- f(...)
term$name <- "wtSum"
term
}
#' @templateVar name Label
#' @template ergmTerm-rdname
#' @usage
#' # valued: Label(formula, label, pos)
InitWtErgmTerm.Label <- function(nw, arglist, ...){
out <- InitErgmTerm.Label(nw, arglist, ...)
out$name <- "wtpassthrough_term"
out
}
#' @templateVar name Curve
#' @template ergmTerm-rdname
#' @usage
#' # valued: Curve(formula, params, map, gradient=NULL, minpar=-Inf, maxpar=+Inf, cov=NULL)
InitWtErgmTerm.Curve <- function(nw, arglist, ...){
out <- InitErgmTerm.Curve(nw, arglist, ...)
out$name <- "wtpassthrough_term"
out
}
InitWtErgmTerm..submodel_and_summary <- function(nw, arglist, ...){
out <- InitErgmTerm..submodel_and_summary(nw, arglist, ...)
out$name <- "_wtsubmodel_and_summary_term"
out
}
#' @templateVar name Curve
#' @template ergmTerm-rdname
#' @usage
#' # valued: Parametrise(formula, params, map, gradient=NULL, minpar=-Inf, maxpar=+Inf,
#' # cov=NULL)
InitWtErgmTerm.Parametrise <- InitWtErgmTerm.Curve
#' @templateVar name Curve
#' @template ergmTerm-rdname
#' @usage
#' # valued: Parametrize(formula, params, map, gradient=NULL, minpar=-Inf, maxpar=+Inf,
#' # cov=NULL)
InitWtErgmTerm.Parametrize <- InitWtErgmTerm.Curve
#' @templateVar name Exp
#' @template ergmTerm-rdname
#' @usage
#' # valued: Exp(formula)
InitWtErgmTerm.Exp <- function(nw, arglist, ...){
out <- InitErgmTerm.Exp(nw, arglist, ...)
out$name <- "wtExp"
out
}
#' @templateVar name Log
#' @template ergmTerm-rdname
#' @usage
#' # valued: Log(formula, log0=-1/sqrt(.Machine$double.eps))
InitWtErgmTerm.Log <- function(nw, arglist, ...){
out <- InitErgmTerm.Log(nw, arglist, ...)
out$name <- "wtLog"
out
}
#' @templateVar name Prod
#' @template ergmTerm-rdname
#' @usage
#' # valued: Prod(formulas, label)
InitWtErgmTerm.Prod <- InitErgmTerm.Prod
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.