| Title: | Common R Scripts and Utilities Used by the Statnet Project Software |
|---|---|
| Description: | Non-statistical utilities used by the software developed by the Statnet Project. They may also be of use to others. |
| Authors: | Pavel N. Krivitsky [aut, cre] (<https://orcid.org/0000-0002-9101-3362>, University of New South Wales), Skye Bender-deMoll [ctb], Chad Klumb [ctb] (University of Washington) |
| Maintainer: | Pavel N. Krivitsky <[email protected]> |
| License: | GPL-3 + file LICENSE |
| Version: | 4.11.0-453 |
| Built: | 2024-11-18 04:25:00 UTC |
| Source: | https://github.com/statnet/statnet.common |
Test if all items in a vector or a list are identical.
all_identical(x)all_identical(x)
x |
a vector or a list |
TRUE if all elements of x are identical to each other.
stopifnot(!all_identical(1:3)) stopifnot(all_identical(list("a", "a", "a")))stopifnot(!all_identical(1:3)) stopifnot(all_identical(list("a", "a", "a")))
Convert to a control list.
as.control.list(x, ...) ## S3 method for class 'control.list' as.control.list(x, ...) ## S3 method for class 'list' as.control.list(x, FUN = NULL, unflat = TRUE, ...)as.control.list(x, ...) ## S3 method for class 'control.list' as.control.list(x, ...) ## S3 method for class 'list' as.control.list(x, FUN = NULL, unflat = TRUE, ...)
x |
An object, usually a |
... |
Additional arguments to methods. |
FUN |
Either a |
unflat |
Logical, indicating whether an attempt should be made to detect whether some of the arguments are appropriate for a lower-level control function and pass them down. |
a control.list object.
as.control.list(control.list): Idempotent method for control lists.
as.control.list(list): The method for plain lists, which runs
them through FUN.
myfun <- function(..., control=control.myfun()){ as.control.list(control) } control.myfun <- function(a=1, b=a+1){ list(a=a,b=b) } myfun() myfun(control = list(a=2)) myfun2 <- function(..., control=control.myfun2()){ as.control.list(control) } control.myfun2 <- function(c=3, d=c+2, myfun=control.myfun()){ list(c=c,d=d,myfun=myfun) } myfun2() # Argument to control.myfun() (i.e., a) gets passed to it, and a # warning is issued for unused argument e. myfun2(control = list(c=3, a=2, e=3))myfun <- function(..., control=control.myfun()){ as.control.list(control) } control.myfun <- function(a=1, b=a+1){ list(a=a,b=b) } myfun() myfun(control = list(a=2)) myfun2 <- function(..., control=control.myfun2()){ as.control.list(control) } control.myfun2 <- function(c=3, d=c+2, myfun=control.myfun()){ list(c=c,d=d,myfun=myfun) } myfun2() # Argument to control.myfun() (i.e., a) gets passed to it, and a # warning is issued for unused argument e. myfun2(control = list(c=3, a=2, e=3))
A wrapper for base::attr which defaults to exact matching.
attr(x, which, exact = TRUE)attr(x, which, exact = TRUE)
x, which, exact
|
as in |
as in base::attr
x <- list() attr(x, "name") <- 10 base::attr(x, "n") stopifnot(is.null(attr(x, "n"))) base::attr(x, "n", exact = TRUE)x <- list() attr(x, "name") <- 10 base::attr(x, "n") stopifnot(is.null(attr(x, "n"))) base::attr(x, "n", exact = TRUE)
This function converts an ordinary list into a control list (if
needed) and checks that the control list passed is appropriate for
the function to be controlled.
check.control.class( OKnames = as.character(ult(sys.calls(), 2)[[1L]]), myname = as.character(ult(sys.calls(), 2)[[1L]]), control = get("control", pos = parent.frame()) )check.control.class( OKnames = as.character(ult(sys.calls(), 2)[[1L]]), myname = as.character(ult(sys.calls(), 2)[[1L]]), control = get("control", pos = parent.frame()) )
OKnames |
List of control function names which are acceptable. |
myname |
Name of the calling function (used in the error message). |
control |
The control list or a list to be converted to a
control list using |
check.control.class() performs the check by looking up
the class of the control argument (defaulting to the control
variable in the calling function) and checking if it matches a
list of acceptable given by OKnames.
Before performing any checks, the control argument (including
the default) will be converted to a control list by calling
as.control.list() on it with the first element of OKnames to
construct the control function.
If control is missing, it will be assumed that the user wants
to modify it in place, and a variable with that name in the
parent environment will be overwritten.
A valid control list for the function in which it is to be
used. If control argument is missing, it will also overwrite
the variable control in the calling environment with it.
In earlier versions, OKnames and myname were
autodetected. This capability has been deprecated and results in
a warning issued once per session. They now need to be set
explicitly.
set.control.class(), print.control.list(), as.control.list()
Compress a matrix or a data frame with duplicated rows, updating row weights to reflect frequencies, or reverse the process, reconstructing a matrix like the one compressed (subject to permutation of rows and weights not adding up to an integer).
compress_rows(x, ...) decompress_rows(x, ...)compress_rows(x, ...) decompress_rows(x, ...)
x |
a weighted matrix or data frame. |
... |
extra arguments for methods. |
For compress_rows A weighted matrix or data frame of the same
type with duplicated rows removed and weights updated appropriately.
compress_rows.data.frame "compresses" a data frame, returning unique rows
and a tally of the number of times each row is repeated, as well as a
permutation vector that can reconstruct the original data frame.
decompress_rows.compressed_rows_df reconstructs the original data frame.
## S3 method for class 'data.frame' compress_rows(x, ...) ## S3 method for class 'compressed_rows_df' decompress_rows(x, ...)## S3 method for class 'data.frame' compress_rows(x, ...) ## S3 method for class 'compressed_rows_df' decompress_rows(x, ...)
x |
For |
... |
Additional arguments, currently unused. |
For compress_rows.data.frame, a list with three
elements:
rows |
Unique rows of |
frequencies |
A vector of the same length as the number or rows, giving the number of times the corresponding row is repeated |
ordering |
A vector such that if
|
rownames |
Row
names of |
For decompress_rows.compressed_rows_df, the original data frame.
(x <- data.frame(V1=sample.int(3,30,replace=TRUE), V2=sample.int(2,30,replace=TRUE), V3=sample.int(4,30,replace=TRUE))) (c <- compress_rows(x)) stopifnot(all(decompress_rows(c)==x))(x <- data.frame(V1=sample.int(3,30,replace=TRUE), V2=sample.int(2,30,replace=TRUE), V3=sample.int(4,30,replace=TRUE))) (c <- compress_rows(x)) stopifnot(all(decompress_rows(c)==x))
Utility method that overrides the standard ‘$’ list accessor to disable
partial matching for ergm control.list objects
## S3 method for class 'control.list' object$name## S3 method for class 'control.list' object$name
object |
list-coearceable object with elements to be searched |
name |
literal character name of list element to search for and return |
Executes getElement instead of $ so
that element names must match exactly to be returned and partially matching
names will not return the wrong object.
Returns the named list element exactly matching name, or
NULL if no matching elements found
Pavel N. Krivitsky
see getElement
Given a control.list, and two prefixes, from and to,
overwrite the elements starting with to with the corresponding
elements starting with from.
control.remap(control, from, to)control.remap(control, from, to)
control |
An object of class |
from |
Prefix of the source of control parameters. |
to |
Prefix of the destination of control parameters. |
An control.list object.
Pavel N. Krivitsky
(l <- set.control.class("test", list(a.x=1, a.y=2))) control.remap(l, "a", "b")(l <- set.control.class("test", list(a.x=1, a.y=2))) control.remap(l, "a", "b")
options() according to a named list, skipping those already
set.This function can be useful for setting default options, which do not override options set elsewhere.
default_options(...)default_options(...)
... |
see |
The return value is same as that of options() (omitting
options already set).
options(onesetting=1) default_options(onesetting=2, anothersetting=3) stopifnot(getOption("onesetting")==1) # Still 1. stopifnot(getOption("anothersetting")==3) default_options(list(yetanothersetting=5, anothersetting=4)) stopifnot(getOption("anothersetting")==3) # Still 3. stopifnot(getOption("yetanothersetting")==5)options(onesetting=1) default_options(onesetting=2, anothersetting=3) stopifnot(getOption("onesetting")==1) # Still 1. stopifnot(getOption("anothersetting")==3) default_options(list(yetanothersetting=5, anothersetting=4)) stopifnot(getOption("anothersetting")==3) # Still 3. stopifnot(getOption("yetanothersetting")==5)
Truncate values of high magnitude in a vector.
deInf(x, replace = 1/.Machine$double.eps)deInf(x, replace = 1/.Machine$double.eps)
x |
a numeric or integer vector. |
replace |
a number or a string |
Returns x with elements whose magnitudes exceed replace
replaced replaced by replace (or its negation). If replace is
"maxint" or "intmax", .Machine$integer.max is used instead.
NA and NAN values are preserved.
.Deprecate_once calls .Deprecated(), passing all its arguments
through, but only the first time it's called.
.Deprecate_method calls
.Deprecated(), but only if a method has been called by name,
i.e., METHOD.CLASS. Like .Deprecate_once it
only issues a warning the first time.
.Deprecate_once(...) .Deprecate_method(generic, class).Deprecate_once(...) .Deprecate_method(generic, class)
... |
arguments passed to |
generic, class
|
strings giving the generic function name and class name of the function to be deprecated. |
## Not run: options(warn=1) # Print warning immediately after the call. f <- function(){ .Deprecate_once("new_f") } f() # Deprecation warning f() # No deprecation warning ## End(Not run) ## Not run: options(warn=1) # Print warning immediately after the call. summary.packageDescription <- function(object, ...){ .Deprecate_method("summary", "packageDescription") invisible(object) } summary(packageDescription("statnet.common")) # No warning. summary.packageDescription(packageDescription("statnet.common")) # Warning. summary.packageDescription(packageDescription("statnet.common")) # No warning. ## End(Not run)## Not run: options(warn=1) # Print warning immediately after the call. f <- function(){ .Deprecate_once("new_f") } f() # Deprecation warning f() # No deprecation warning ## End(Not run) ## Not run: options(warn=1) # Print warning immediately after the call. summary.packageDescription <- function(object, ...){ .Deprecate_method("summary", "packageDescription") invisible(object) } summary(packageDescription("statnet.common")) # No warning. summary.packageDescription(packageDescription("statnet.common")) # Warning. summary.packageDescription(packageDescription("statnet.common")) # No warning. ## End(Not run)
A one-line function to strip whitespace from its argument.
despace(s)despace(s)
s |
a character vector. |
stopifnot(despace("\n \t ")=="")stopifnot(despace("\n \t ")=="")
Identify and the differences between two control lists.
## S3 method for class 'control.list' diff(x, y = eval(call(class(x)[[1L]])), ignore.environment = TRUE, ...) ## S3 method for class 'diff.control.list' print(x, ..., indent = "")## S3 method for class 'control.list' diff(x, y = eval(call(class(x)[[1L]])), ignore.environment = TRUE, ...) ## S3 method for class 'diff.control.list' print(x, ..., indent = "")
x |
a |
y |
a reference |
ignore.environment |
whether environment for environment-bearing parameters (such as formulas and functions) should be considered when comparing. |
... |
Additional arguments to methods. |
indent |
an argument for recursive calls, to facilitate indentation of nested lists. |
An object of class diff.control.list: a named list with
an element for each non-identical setting. The element is either
itself a diff.control.list (if the setting is a control list)
or a named list with elements x and y, containing x's and
y's values of the parameter for that setting.
print(diff.control.list): A print method.
Replace an object's environment with a simple, static environment.
empty_env(object) base_env(object)empty_env(object) base_env(object)
object |
An object with the |
An object of the same type as object, with updated environment.
f <- y~x environment(f) # GlobalEnv environment(empty_env(f)) # EmptyEnv environment(base_env(f)) # base package environmentf <- y~x environment(f) # GlobalEnv environment(empty_env(f)) # EmptyEnv environment(base_env(f)) # base package environment
try-error (result of try encountering an error.This function is inspired by NVL, and simply returns the first
argument that is not a try-error, raising an error if all arguments
are try-errors.
ERRVL(...)ERRVL(...)
... |
Expressions to be tested; usually outputs of
|
The first argument that is not a try-error. Stops
with an error if all are.
This function uses lazy evaluation, so, for example ERRVL(1, stop("Error!")) will never evaluate the stop call and will
not produce an error, whereas ERRVL(try(solve(0)), stop("Error!")) would.
In addition, all expressions after the first may contain a .,
which is substituted with the try-error object returned by the
previous expression.
print(ERRVL(1,2,3)) # 1 print(ERRVL(try(solve(0)),2,3)) # 2 print(ERRVL(1, stop("Error!"))) # No error ## Not run: # Error: print(ERRVL(try(solve(0), silent=TRUE), stop("Error!"))) # Error with an elaborate message: print(ERRVL(try(solve(0), silent=TRUE), stop("Stopped with an error: ", .))) ## End(Not run)print(ERRVL(1,2,3)) # 1 print(ERRVL(try(solve(0)),2,3)) # 2 print(ERRVL(1, stop("Error!"))) # No error ## Not run: # Error: print(ERRVL(try(solve(0), silent=TRUE), stop("Error!"))) # Error with an elaborate message: print(ERRVL(try(solve(0), silent=TRUE), stop("Stopped with an error: ", .))) ## End(Not run)
This is a thin wrapper around format.pval() that guarantees fixed
(not scientific) notation, links (by default) the eps argument to
the digits argument and vice versa, and sets nsmall to equal
digits.
fixed.pval( pv, digits = max(1, getOption("digits") - 2), eps = 10^-digits, na.form = "NA", ... )fixed.pval( pv, digits = max(1, getOption("digits") - 2), eps = 10^-digits, na.form = "NA", ... )
pv, digits, eps, na.form, ...
|
see |
A character vector.
pvs <- 10^((0:-12)/2) # Jointly: fpf <- fixed.pval(pvs, digits = 3) fpf format.pval(pvs, digits = 3) # compare # Individually: fpf <- sapply(pvs, fixed.pval, digits = 3) fpf sapply(pvs, format.pval, digits = 3) # compare # Control eps: fpf <- sapply(pvs, fixed.pval, eps = 1e-3) fpfpvs <- 10^((0:-12)/2) # Jointly: fpf <- fixed.pval(pvs, digits = 3) fpf format.pval(pvs, digits = 3) # compare # Individually: fpf <- sapply(pvs, fixed.pval, digits = 3) fpf sapply(pvs, format.pval, digits = 3) # compare # Control eps: fpf <- sapply(pvs, fixed.pval, eps = 1e-3) fpf
This function uses
parallel::mcparallel(),
so the time limit is not
enforced on Windows. However, unlike functions using setTimeLimit(), the time
limit is enforced even on native code.
forkTimeout( expr, timeout, unsupported = c("warning", "error", "message", "silent"), onTimeout = NULL )forkTimeout( expr, timeout, unsupported = c("warning", "error", "message", "silent"), onTimeout = NULL )
expr |
expression to be evaluated. |
timeout |
number of seconds to wait for the expression to evaluate. |
unsupported |
a character vector of length 1 specifying how to
handle a platform that does not support
Partial matching is used. |
onTimeout |
Value to be returned on time-out. |
Result of evaluating expr if completed, onTimeout
otherwise.
onTimeout can itself be an expression, so it is, for
example, possible to stop with an error by passing
onTimeout=stop().
Note that this function is not completely transparent: side-effects may behave in unexpected ways. In particular, RNG state will not be updated.
forkTimeout({Sys.sleep(1); TRUE}, 2) # TRUE forkTimeout({Sys.sleep(1); TRUE}, 0.5) # NULL (except on Windows)forkTimeout({Sys.sleep(1); TRUE}, 2) # TRUE forkTimeout({Sys.sleep(1); TRUE}, 0.5) # NULL (except on Windows)
A suite of utilities for handling model formulas of the style used in Statnet packages.
append_rhs.formula( object = NULL, newterms, keep.onesided = FALSE, env = if (is.null(object)) NULL else environment(object) ) append.rhs.formula(object, newterms, keep.onesided = FALSE) filter_rhs.formula(object, f, ...) nonsimp_update.formula(object, new, ..., from.new = FALSE) nonsimp.update.formula(object, new, ..., from.new = FALSE) term.list.formula(rhs, sign = +1) list_summands.call(object) list_rhs.formula(object) eval_lhs.formula(object)append_rhs.formula( object = NULL, newterms, keep.onesided = FALSE, env = if (is.null(object)) NULL else environment(object) ) append.rhs.formula(object, newterms, keep.onesided = FALSE) filter_rhs.formula(object, f, ...) nonsimp_update.formula(object, new, ..., from.new = FALSE) nonsimp.update.formula(object, new, ..., from.new = FALSE) term.list.formula(rhs, sign = +1) list_summands.call(object) list_rhs.formula(object) eval_lhs.formula(object)
object |
formula object to be updated or evaluated |
newterms |
a |
keep.onesided |
if the initial formula is one-sided, keep it whether to keep it one-sided or whether to make the initial formula the new LHS |
env |
an environment for the new formula, if |
f |
a function whose first argument is the term and whose
additional arguments are forwarded from |
... |
Additional arguments. Currently unused. |
new |
new formula to be used in updating |
from.new |
logical or character vector of variable names. controls how environment of formula gets updated. |
rhs, sign
|
Arguments to the deprecated |
append_rhs.formula each return an updated formula
object; if object is NULL (the default), a one-sided formula
containing only the terms in newterms will be returned.
nonsimp_update.formula each return an
updated formula object
list_summands.call returns an object of type
term_list; its "env" attribute is set to a list of
NULLs, however.
list_rhs.formula returns an object of type term_list.
eval_lhs.formula an object of whatever type the LHS evaluates to.
append_rhs.formula(): append_rhs.formula appends a list of terms to the RHS of a
formula. If the formula is one-sided, the RHS becomes the LHS, if
keep.onesided==FALSE (the default).
append.rhs.formula(): append.rhs.formula has been renamed to append_rhs.formula.
filter_rhs.formula(): filter_rhs.formula filters through the terms in the RHS of a
formula, returning a formula without the terms for which function
f(term, ...) is FALSE. Terms inside another term (e.g.,
parentheses or an operator other than + or -) will be unaffected.
nonsimp_update.formula(): nonsimp_update.formula is a reimplementation of
update.formula that does not simplify. Note that the
resulting formula's environment is set as follows. If
from.new==FALSE, it is set to that of object. Otherwise, a new
sub-environment of object, containing, in addition, variables in new listed
in from.new (if a character vector) or all of new (if TRUE).
nonsimp.update.formula(): nonsimp.update.formula has been renamed to nonsimp_update.formula.
term.list.formula(): term.list.formula is an older version of list_rhs.formula that required the RHS call, rather than the formula itself.
list_summands.call(): list_summands.call, given an unevaluated call or expression
containing the sum of one or more terms, returns an object of class term_list with the
terms being summed, handling + and - operators and
parentheses, and keeping track of whether a term has a plus or a
minus sign.
list_rhs.formula(): list_rhs.formula returns an object of type term_list,
containing terms in a given formula, handling + and -
operators and parentheses, and keeping track of whether a term has
a plus or a minus sign.
eval_lhs.formula(): eval_lhs.formula extracts the LHS of a formula, evaluates it in the formula's environment, and returns the result.
## append_rhs.formula (f1 <- append_rhs.formula(y~x,list(as.name("z1"),as.name("z2")))) (f2 <- append_rhs.formula(~y,list(as.name("z")))) (f3 <- append_rhs.formula(~y+x,structure(list(as.name("z")),sign=-1))) (f4 <- append_rhs.formula(~y,list(as.name("z")),TRUE)) (f5 <- append_rhs.formula(y~x,~z1-z2)) (f6 <- append_rhs.formula(NULL,list(as.name("z")))) (f7 <- append_rhs.formula(NULL,structure(list(as.name("z")),sign=-1))) fe <- ~z2+z3 environment(fe) <- new.env() (f8 <- append_rhs.formula(NULL, fe)) # OK (f9 <- append_rhs.formula(y~x, fe)) # Warning (f10 <- append_rhs.formula(y~x, fe, env=NULL)) # No warning, environment from fe. (f11 <- append_rhs.formula(fe, ~z1)) # Warning, environment from fe ## filter_rhs.formula (f1 <- filter_rhs.formula(~a-b+c, `!=`, "a")) (f2 <- filter_rhs.formula(~-a+b-c, `!=`, "a")) (f3 <- filter_rhs.formula(~a-b+c, `!=`, "b")) (f4 <- filter_rhs.formula(~-a+b-c, `!=`, "b")) (f5 <- filter_rhs.formula(~a-b+c, `!=`, "c")) (f6 <- filter_rhs.formula(~-a+b-c, `!=`, "c")) (f7 <- filter_rhs.formula(~c-a+b-c(a), function(x) (if(is.call(x)) x[[1]] else x)!="c")) stopifnot(identical(list_rhs.formula(a~b), structure(alist(b), sign=1, env=list(globalenv()), class="term_list"))) stopifnot(identical(list_rhs.formula(~b), structure(alist(b), sign=1, env=list(globalenv()), class="term_list"))) stopifnot(identical(list_rhs.formula(~b+NULL), structure(alist(b, NULL), sign=c(1,1), env=rep(list(globalenv()), 2), class="term_list"))) stopifnot(identical(list_rhs.formula(~-b+NULL), structure(alist(b, NULL), sign=c(-1,1), env=rep(list(globalenv()), 2), class="term_list"))) stopifnot(identical(list_rhs.formula(~+b-NULL), structure(alist(b, NULL), sign=c(1,-1), env=rep(list(globalenv()), 2), class="term_list"))) stopifnot(identical(list_rhs.formula(~+b-(NULL+c)), structure(alist(b, NULL, c), sign=c(1,-1,-1), env=rep(list(globalenv()), 3), class="term_list"))) ## eval_lhs.formula (result <- eval_lhs.formula((2+2)~1)) stopifnot(identical(result,4))## append_rhs.formula (f1 <- append_rhs.formula(y~x,list(as.name("z1"),as.name("z2")))) (f2 <- append_rhs.formula(~y,list(as.name("z")))) (f3 <- append_rhs.formula(~y+x,structure(list(as.name("z")),sign=-1))) (f4 <- append_rhs.formula(~y,list(as.name("z")),TRUE)) (f5 <- append_rhs.formula(y~x,~z1-z2)) (f6 <- append_rhs.formula(NULL,list(as.name("z")))) (f7 <- append_rhs.formula(NULL,structure(list(as.name("z")),sign=-1))) fe <- ~z2+z3 environment(fe) <- new.env() (f8 <- append_rhs.formula(NULL, fe)) # OK (f9 <- append_rhs.formula(y~x, fe)) # Warning (f10 <- append_rhs.formula(y~x, fe, env=NULL)) # No warning, environment from fe. (f11 <- append_rhs.formula(fe, ~z1)) # Warning, environment from fe ## filter_rhs.formula (f1 <- filter_rhs.formula(~a-b+c, `!=`, "a")) (f2 <- filter_rhs.formula(~-a+b-c, `!=`, "a")) (f3 <- filter_rhs.formula(~a-b+c, `!=`, "b")) (f4 <- filter_rhs.formula(~-a+b-c, `!=`, "b")) (f5 <- filter_rhs.formula(~a-b+c, `!=`, "c")) (f6 <- filter_rhs.formula(~-a+b-c, `!=`, "c")) (f7 <- filter_rhs.formula(~c-a+b-c(a), function(x) (if(is.call(x)) x[[1]] else x)!="c")) stopifnot(identical(list_rhs.formula(a~b), structure(alist(b), sign=1, env=list(globalenv()), class="term_list"))) stopifnot(identical(list_rhs.formula(~b), structure(alist(b), sign=1, env=list(globalenv()), class="term_list"))) stopifnot(identical(list_rhs.formula(~b+NULL), structure(alist(b, NULL), sign=c(1,1), env=rep(list(globalenv()), 2), class="term_list"))) stopifnot(identical(list_rhs.formula(~-b+NULL), structure(alist(b, NULL), sign=c(-1,1), env=rep(list(globalenv()), 2), class="term_list"))) stopifnot(identical(list_rhs.formula(~+b-NULL), structure(alist(b, NULL), sign=c(1,-1), env=rep(list(globalenv()), 2), class="term_list"))) stopifnot(identical(list_rhs.formula(~+b-(NULL+c)), structure(alist(b, NULL, c), sign=c(1,-1,-1), env=rep(list(globalenv()), 3), class="term_list"))) ## eval_lhs.formula (result <- eval_lhs.formula((2+2)~1)) stopifnot(identical(result,4))
control.*() function semantics.This function takes the arguments of its caller (whose name should
be passed explicitly), plus any ... arguments and produces a
control list based on the standard semantics of control.*()
functions, including handling deprecated arguments, identifying
undefined arguments, and handling arguments that should be passed
through match.arg().
handle.controls(myname, ...)handle.controls(myname, ...)
myname |
the name of the calling function. |
... |
the |
The function behaves based on the information it acquires from the calling function. Specifically,
The values of formal arguments (except ..., if present) are
taken from the environment of the calling function and stored in
the list.
If the calling function has a ... argument and defines an
old.controls variable in its environment, then it remaps the
names in ... to their new names based on old.controls. In
addition, if the value is a list with two elements, action and
message, the standard deprecation message will have message
appended to it and then be called with action().
If the calling function has a match.arg.pars in its
environment, the arguments in that list are processed through
match.arg().
a list with formal arguments of the calling function.
Test if the object is a matrix that is symmetric and positive definite
is.SPD(x, tol = .Machine$double.eps)is.SPD(x, tol = .Machine$double.eps)
x |
the object to be tested. |
tol |
the tolerance for the reciprocal condition number. |
These functions first search the given environment, then search all loaded environments, including those where the function is not exported. If found, they return an unambiguous reference to the function.
locate_function(name, env = globalenv(), ...) locate_prefixed_function( name, prefix, errname, env = globalenv(), ..., call. = FALSE )locate_function(name, env = globalenv(), ...) locate_prefixed_function( name, prefix, errname, env = globalenv(), ..., call. = FALSE )
name |
a character string giving the function's name. |
env |
an |
... |
additional arguments to the warning and error warning messages. See Details. |
prefix |
a character string giving the prefix, so the
searched-for function is |
errname |
a character string; if given, if the function is not
found an error is raised, with |
call. |
a logical, whether the call
( |
If the initial search fails, a search using
getAnywhere() is attempted, with exported ("visible") functions
with the specified name preferred over those that are not. When
multiple equally qualified functions are available, a warning is
printed and an arbitrary one is returned.
Because getAnywhere() can be slow, past searches are cached.
If the function is found, an unevaluated call of the form
ENVNAME:::FUNNAME, which can then be used to call the function
even if it is unexported. If the environment does not have a
name, or is GlobalEnv, only FUNNAME is returned. Otherwise,
NULL is returned.
locate_function(): a low-level function returning the
reference to the function named name, or NULL if not found.
locate_prefixed_function(): a helper function that searches for a
function of the form prefix.name and produces an informative
error message if not found.
# Locate a random function in base. locate_function(".row_names_info")# Locate a random function in base. locate_function(".row_names_info")
A small suite of functions to compute sums, means, and weighted means on logarithmic scale, minimizing loss of precision.
log_sum_exp(logx, use_ldouble = FALSE) log_mean_exp(logx, use_ldouble = FALSE) lweighted.mean(x, logw) lweighted.var(x, logw, onerow = NA) lweighted.cov(x, y, logw, onerow = NA)log_sum_exp(logx, use_ldouble = FALSE) log_mean_exp(logx, use_ldouble = FALSE) lweighted.mean(x, logw) lweighted.var(x, logw, onerow = NA) lweighted.cov(x, y, logw, onerow = NA)
logx |
Numeric vector of |
use_ldouble |
Whether to use |
x, y
|
Numeric vectors or matrices of |
logw |
Numeric vector of |
onerow |
If given a matrix or matrices with only one row
(i.e., sample size 1), |
The functions return the equivalents of the R expressions given below, but faster and with less loss of precision.
log_sum_exp(): log(sum(exp(logx)))
log_mean_exp(): log(mean(exp(logx)))
lweighted.mean(): weighted mean of x:
sum(x*exp(logw))/sum(exp(logw)) for x scalar and
colSums(x*exp(logw))/sum(exp(logw)) for x matrix
lweighted.var(): weighted variance of x: crossprod(x-lweighted.mean(x,logw)*exp(logw/2))/sum(exp(logw))
lweighted.cov(): weighted covariance between x and y: crossprod(x-lweighted.mean(x,logw)*exp(logw/2), y-lweighted.mean(y,logw)*exp(logw/2))/sum(exp(logw))
Pavel N. Krivitsky
x <- rnorm(1000) stopifnot(all.equal(log_sum_exp(x), log(sum(exp(x))), check.attributes=FALSE)) stopifnot(all.equal(log_mean_exp(x), log(mean(exp(x))), check.attributes=FALSE)) logw <- rnorm(1000) stopifnot(all.equal(m <- sum(x*exp(logw))/sum(exp(logw)),lweighted.mean(x, logw))) stopifnot(all.equal(sum((x-m)^2*exp(logw))/sum(exp(logw)), lweighted.var(x, logw), check.attributes=FALSE)) x <- cbind(x, rnorm(1000)) stopifnot(all.equal(mx <- colSums(x*exp(logw))/sum(exp(logw)), lweighted.mean(x, logw), check.attributes=FALSE)) stopifnot(all.equal(crossprod(t(t(x)-mx)*exp(logw/2))/sum(exp(logw)), lweighted.var(x, logw), check.attributes=FALSE)) y <- cbind(x, rnorm(1000)) my <- colSums(y*exp(logw))/sum(exp(logw)) stopifnot(all.equal(crossprod(t(t(x)-mx)*exp(logw/2), t(t(y)-my)*exp(logw/2))/sum(exp(logw)), lweighted.cov(x, y, logw), check.attributes=FALSE)) stopifnot(all.equal(crossprod(t(t(y)-my)*exp(logw/2), t(t(x)-mx)*exp(logw/2))/sum(exp(logw)), lweighted.cov(y, x, logw), check.attributes=FALSE))x <- rnorm(1000) stopifnot(all.equal(log_sum_exp(x), log(sum(exp(x))), check.attributes=FALSE)) stopifnot(all.equal(log_mean_exp(x), log(mean(exp(x))), check.attributes=FALSE)) logw <- rnorm(1000) stopifnot(all.equal(m <- sum(x*exp(logw))/sum(exp(logw)),lweighted.mean(x, logw))) stopifnot(all.equal(sum((x-m)^2*exp(logw))/sum(exp(logw)), lweighted.var(x, logw), check.attributes=FALSE)) x <- cbind(x, rnorm(1000)) stopifnot(all.equal(mx <- colSums(x*exp(logw))/sum(exp(logw)), lweighted.mean(x, logw), check.attributes=FALSE)) stopifnot(all.equal(crossprod(t(t(x)-mx)*exp(logw/2))/sum(exp(logw)), lweighted.var(x, logw), check.attributes=FALSE)) y <- cbind(x, rnorm(1000)) my <- colSums(y*exp(logw))/sum(exp(logw)) stopifnot(all.equal(crossprod(t(t(x)-mx)*exp(logw/2), t(t(y)-my)*exp(logw/2))/sum(exp(logw)), lweighted.cov(x, y, logw), check.attributes=FALSE)) stopifnot(all.equal(crossprod(t(t(y)-my)*exp(logw/2), t(t(x)-mx)*exp(logw/2))/sum(exp(logw)), lweighted.cov(y, x, logw), check.attributes=FALSE))
mcmc.list objectscolMeans.mcmc.list is a "method" for (non-generic) colMeans() applicable to mcmc.list objects.
var.mcmc.list is a "method" for (non-generic)
var() applicable to mcmc.list objects. Since MCMC chains
are assumed to all be sampling from the same underlying
distribution, their pooled mean is used.
sweep.mcmc.list is a "method" for (non-generic)
sweep() applicable to mcmc.list objects.
lapply.mcmc.list is a "method" for (non-generic)
lapply() applicable to mcmc.list objects.
colMeans.mcmc.list(x, ...) var.mcmc.list(x, ...) sweep.mcmc.list(x, STATS, FUN = "-", check.margin = TRUE, ...) lapply.mcmc.list(X, FUN, ...)colMeans.mcmc.list(x, ...) var.mcmc.list(x, ...) sweep.mcmc.list(x, STATS, FUN = "-", check.margin = TRUE, ...) lapply.mcmc.list(X, FUN, ...)
x |
a |
... |
additional arguments to the functions evaluated on each chain. |
STATS, FUN, check.margin
|
See help for |
X |
An |
These implementations should be equivalent (within
numerical error) to the same function being called on
as.matrix(x), while avoiding construction of the large matrix.
colMeans.mcmc returns a vector with length equal to
the number of mcmc chains in x with the mean value for
each chain.
sweep.mcmc.list returns an appropriately modified
version of x
lapply.mcmc.list returns an mcmc.list each of
whose chains had been passed through FUN.
data(line, package="coda") colMeans(as.matrix(line)) # also coda colMeans.mcmc.list(line) # "Method" data(line, package="coda") var(as.matrix(line)) # coda var.mcmc.list(line) # "Method" data(line, package="coda") colMeans.mcmc.list(line)-1:3 colMeans.mcmc.list(sweep.mcmc.list(line, 1:3)) data(line, package="coda") colMeans.mcmc.list(line)[c(2,3,1)] colMeans.mcmc.list(lapply.mcmc.list(line, `[`,,c(2,3,1)))data(line, package="coda") colMeans(as.matrix(line)) # also coda colMeans.mcmc.list(line) # "Method" data(line, package="coda") var(as.matrix(line)) # coda var.mcmc.list(line) # "Method" data(line, package="coda") colMeans.mcmc.list(line)-1:3 colMeans.mcmc.list(sweep.mcmc.list(line, 1:3)) data(line, package="coda") colMeans.mcmc.list(line)[c(2,3,1)] colMeans.mcmc.list(lapply.mcmc.list(line, `[`,,c(2,3,1)))
print objects to the message output.A thin wrapper around print that captures its output and prints
it as a message, usually to STDERR.
message_print(..., messageArgs = NULL)message_print(..., messageArgs = NULL)
... |
arguments to |
messageArgs |
a list of arguments to be passed directly to |
cat(1:5) print(1:5) message_print(1:5) # Looks the same (though may be in a different color on some frontends). suppressMessages(print(1:5)) # Still prints suppressMessages(message_print(1:5)) # Silencedcat(1:5) print(1:5) message_print(1:5) # Looks the same (though may be in a different color on some frontends). suppressMessages(print(1:5)) # Still prints suppressMessages(message_print(1:5)) # Silenced
This is a helper function that enables a function to modify its argument in place, emulating behavior of R6 classes and methods in the network. It should typically be the last line of the calling function.
modify_in_place(x, value = x)modify_in_place(x, value = x)
x |
the argument (not its name!) to be modified |
value |
the value to assign (defaulting to the current value of |
This function determines whether the argument can be assigned to by actually attempting to do so. If this results in an error, for example, because the argument is anonymous, the error is silently ignored.
It can be called multiple times by the same function to modify multiple arguments. It uses the on.exit() mechanism, adding to the list. Thus, if some other function calls on.exit(..., add = FALSE) (the default) afterwards, modify_in_place() will fail silently.
value, invisibly, while attempting to modify x in place
## A function that increments its argument in place: inc <- function(x){ modify_in_place(x, x+1) } y <- 1 z <- 1 stopifnot(inc(z) == 2) stopifnot(z == 2) stopifnot(inc(y) == 2) stopifnot(y == 2) stopifnot(inc(z) == 3) stopifnot(z == 3) stopifnot(inc(identity(z)) == 4) stopifnot(z == 3) # Not updated! ## Modify an argument that's been updated in place: inc2 <- function(y){ y <- y + 1 modify_in_place(y) } z stopifnot(inc2(z) == 4) stopifnot(z == 4) ## Decrement the first argument, increment the second: incdec <- function(x,y){ modify_in_place(x, x-1) modify_in_place(y, y+1) } c(y,z) incdec(y,z) stopifnot(all(c(y,z) == c(1,5)))## A function that increments its argument in place: inc <- function(x){ modify_in_place(x, x+1) } y <- 1 z <- 1 stopifnot(inc(z) == 2) stopifnot(z == 2) stopifnot(inc(y) == 2) stopifnot(y == 2) stopifnot(inc(z) == 3) stopifnot(z == 3) stopifnot(inc(identity(z)) == 4) stopifnot(z == 3) # Not updated! ## Modify an argument that's been updated in place: inc2 <- function(y){ y <- y + 1 modify_in_place(y) } z stopifnot(inc2(z) == 4) stopifnot(z == 4) ## Decrement the first argument, increment the second: incdec <- function(x,y){ modify_in_place(x, x-1) modify_in_place(y, y+1) } c(y,z) incdec(y,z) stopifnot(all(c(y,z) == c(1,5)))
NULL objects.Convenience functions for handling NULL objects.
NVL(...) NVL2(test, notnull, null = NULL) NVL3(test, notnull, null = NULL) EVL(...) EVL2(test, notnull, null = NULL) EVL3(test, notnull, null = NULL) NVL(x) <- value EVL(x) <- valueNVL(...) NVL2(test, notnull, null = NULL) NVL3(test, notnull, null = NULL) EVL(...) EVL2(test, notnull, null = NULL) EVL3(test, notnull, null = NULL) NVL(x) <- value EVL(x) <- value
..., test
|
expressions to be tested. |
notnull |
expression to be returned if |
null |
expression to be returned if |
x |
an object to be overwritten if |
value |
new value for |
NVL(): Inspired by SQL function NVL, returns the first argument
that is not NULL, or NULL if all arguments are
NULL.
NVL2(): Inspired by Oracle SQL function NVL2, returns the second argument
if the first argument is not NULL and the third argument if the
first argument is NULL. The third argument defaults to NULL, so
NVL2(a, b) can serve as shorthand for (if(!is.null(a)) b).
NVL3(): Inspired by Oracle SQL NVL2 function and magittr %>%
operator, behaves as NVL2 but .s in the second argument are
substituted with the first argument.
EVL(): As NVL, but for any objects of length 0 (Empty) rather than just NULL. Note that if no non-zero-length arguments are given, NULL is returned.
EVL2(): As NVL2, but for any objects of length 0 (Empty) rather than just NULL.
EVL3(): As NVL3, but for any objects of length 0 (Empty) rather than just NULL.
NVL(x) <- value: Assigning to NVL overwrites its first argument if that argument
is NULL. Note that it will always return the right-hand-side
of the assignment (value), regardless of what x is.
EVL(x) <- value: As assignment to NVL, but for any objects of length 0 (Empty) rather than just NULL.
Whenever possible, these functions use lazy evaluation, so,
for example NVL(1, stop("Error!")) will never evaluate the
stop call and will not produce an error, whereas NVL(NULL, stop("Error!")) would.
a <- NULL a # NULL NVL(a,0) # 0 b <- 1 b # 1 NVL(b,0) # 1 # Here, object x does not exist, but since b is not NULL, x is # never evaluated, so the statement finishes. NVL(b,x) # 1 # Also, NVL(NULL,1,0) # 1 NVL(NULL,0,1) # 0 NVL(NULL,NULL,0) # 0 NVL(NULL,NULL,NULL) # NULL NVL2(a, "not null!", "null!") # "null!" NVL2(b, "not null!", "null!") # "not null!" NVL3(a, "not null!", "null!") # "null!" NVL3(b, .+1, "null!") # 2 NVL(NULL*2, 1) # numeric(0) is not NULL EVL(NULL*2, 1) # 1 NVL(a) <- 2 a # 2 NVL(b) <- 2 b # still 1a <- NULL a # NULL NVL(a,0) # 0 b <- 1 b # 1 NVL(b,0) # 1 # Here, object x does not exist, but since b is not NULL, x is # never evaluated, so the statement finishes. NVL(b,x) # 1 # Also, NVL(NULL,1,0) # 1 NVL(NULL,0,1) # 0 NVL(NULL,NULL,0) # 0 NVL(NULL,NULL,NULL) # NULL NVL2(a, "not null!", "null!") # "null!" NVL2(b, "not null!", "null!") # "not null!" NVL3(a, "not null!", "null!") # "null!" NVL3(b, .+1, "null!") # 2 NVL(NULL*2, 1) # numeric(0) is not NULL EVL(NULL*2, 1) # 1 NVL(a) <- 2 a # 2 NVL(b) <- 2 b # still 1
This is a purrr-style adverb that checks if a given function has
already been called with a given configuration of arguments and
skips it if it has.
once(f, expire_after = Inf, max_entries = Inf)once(f, expire_after = Inf, max_entries = Inf)
f |
A function to modify. |
expire_after |
The number of seconds since it was added to the database before a particular configuration is "forgotten". This can be used to periodically remind the user without overwhelming them. |
max_entries |
The number of distinct configurations to
remember. If not |
Each modified function instance returned by once()
maintains a database of previous argument configurations. They
are not in any way compressed, so this database may grow over
time. Thus, this wrapper should be used with caution if arguments
are large objects. This may be replaced with hashing in the
future. In the meantime, you may want to set the max_entries
argument to be safe.
Different instances of a modified function do not share databases, even if the function is the same. This means that if you, say, modify a function within another function, the modified function will call once per call to the outer function. Modified functions defined at package level count as the same "instance", however. See example.
Because the function needs to test whether a particular configuration of arguments have already been used, do not rely on lazy evaluation behaviour.
msg <- once(message) msg("abc") # Prints. msg("abc") # Silent. msg <- once(message) # Starts over. msg("abc") # Prints. f <- function(){ innermsg <- once(message) innermsg("efg") # Prints once per call to f(). innermsg("efg") # Silent. msg("abcd") # Prints only the first time f() is called. msg("abcd") # Silent. } f() # Prints "efg" and "abcd". f() # Prints only "efg". msg3 <- once(message, max_entries=3) msg3("a") # 1 remembered. msg3("a") # Silent. msg3("b") # 2 remembered. msg3("a") # Silent. msg3("c") # 3 remembered. msg3("a") # Silent. msg3("d") # "a" forgotten. msg3("a") # Printed. msg2s <- once(message, expire_after=2) msg2s("abc") # Prints. msg2s("abc") # Silent. Sys.sleep(1) msg2s("abc") # Silent after 1 sec. Sys.sleep(1.1) msg2s("abc") # Prints after 2.1 sec.msg <- once(message) msg("abc") # Prints. msg("abc") # Silent. msg <- once(message) # Starts over. msg("abc") # Prints. f <- function(){ innermsg <- once(message) innermsg("efg") # Prints once per call to f(). innermsg("efg") # Silent. msg("abcd") # Prints only the first time f() is called. msg("abcd") # Silent. } f() # Prints "efg" and "abcd". f() # Prints only "efg". msg3 <- once(message, max_entries=3) msg3("a") # 1 remembered. msg3("a") # Silent. msg3("b") # 2 remembered. msg3("a") # Silent. msg3("c") # 3 remembered. msg3("a") # Silent. msg3("d") # "a" forgotten. msg3("a") # Printed. msg2s <- once(message, expire_after=2) msg2s("abc") # Prints. msg2s("abc") # Silent. Sys.sleep(1) msg2s("abc") # Silent after 1 sec. Sys.sleep(1.1) msg2s("abc") # Prints after 2.1 sec.
A convenience wrapper to run code based on whether an environment variable is defined.
opttest( expr, testname = NULL, testvar = "ENABLE_statnet_TESTS", yesvals = c("y", "yes", "t", "true", "1"), lowercase = TRUE )opttest( expr, testname = NULL, testvar = "ENABLE_statnet_TESTS", yesvals = c("y", "yes", "t", "true", "1"), lowercase = TRUE )
expr |
An expression to be evaluated only if |
testname |
Optional name of the test. If given, and the test is skipped, will print a message to that end, including the name of the test, and instructions on how to enable it. |
testvar |
Environment variable name. If set to one of the
|
yesvals |
A character vector of strings considered affirmative values
for |
lowercase |
Whether to convert the value of |
sort and order methods for
data.frame and matrix, sorting it in
lexicographic order.These function return a data frame sorted in lexcographic order or a permutation that will rearrange it into lexicographic order: first by the first column, ties broken by the second, remaining ties by the third, etc..
order(..., na.last = TRUE, decreasing = FALSE) ## Default S3 method: order(..., na.last = TRUE, decreasing = FALSE) ## S3 method for class 'data.frame' order(..., na.last = TRUE, decreasing = FALSE) ## S3 method for class 'matrix' order(..., na.last = TRUE, decreasing = FALSE) ## S3 method for class 'data.frame' sort(x, decreasing = FALSE, ...)order(..., na.last = TRUE, decreasing = FALSE) ## Default S3 method: order(..., na.last = TRUE, decreasing = FALSE) ## S3 method for class 'data.frame' order(..., na.last = TRUE, decreasing = FALSE) ## S3 method for class 'matrix' order(..., na.last = TRUE, decreasing = FALSE) ## S3 method for class 'data.frame' sort(x, decreasing = FALSE, ...)
... |
Ignored for |
na.last |
See |
decreasing |
Whether to sort in decreasing order. |
x |
A |
For sort, a data frame, sorted lexicographically. For
order, a permutation I (of a vector 1:nrow(x)) such
that x[I,,drop=FALSE] equals x ordered lexicographically.
data.frame, sort, order,
matrix
data(iris) head(iris) head(order(iris)) head(sort(iris)) stopifnot(identical(sort(iris),iris[order(iris),]))data(iris) head(iris) head(order(iris)) head(sort(iris)) stopifnot(identical(sort(iris),iris[order(iris),]))
A vector x becomes "x[1]", "x[1] and x[2]", or
"x[1], x[2], and x[3]", depending on the langth of
x.
paste.and(x, oq = "", cq = "", con = "and")paste.and(x, oq = "", cq = "", con = "and")
x |
A vector. |
oq |
Opening quotation symbol. (Defaults to none.) |
cq |
Closing quotation symbol. (Defaults to none.) |
con |
Conjunction to be used if |
A string with the output.
paste, cat
print(paste.and(c())) print(paste.and(1)) print(paste.and(1:2)) print(paste.and(1:3)) print(paste.and(1:4,con='or'))print(paste.and(c())) print(paste.and(1)) print(paste.and(1:2)) print(paste.and(1:3)) print(paste.and(1:4,con='or'))
A pair of functions paralleling eval() and evalq() that make
multiple attempts at evaluating an expression, retrying on error up
to a specified number of attempts, and optionally evaluating
another expression before restarting.
persistEval( expr, retries = NVL(getOption("eval.retries"), 5), beforeRetry, envir = parent.frame(), enclos = if (is.list(envir) || is.pairlist(envir)) parent.frame() else baseenv(), verbose = FALSE ) persistEvalQ( expr, retries = NVL(getOption("eval.retries"), 5), beforeRetry, envir = parent.frame(), enclos = if (is.list(envir) || is.pairlist(envir)) parent.frame() else baseenv(), verbose = FALSE )persistEval( expr, retries = NVL(getOption("eval.retries"), 5), beforeRetry, envir = parent.frame(), enclos = if (is.list(envir) || is.pairlist(envir)) parent.frame() else baseenv(), verbose = FALSE ) persistEvalQ( expr, retries = NVL(getOption("eval.retries"), 5), beforeRetry, envir = parent.frame(), enclos = if (is.list(envir) || is.pairlist(envir)) parent.frame() else baseenv(), verbose = FALSE )
expr |
an expression to be retried; note the difference
between |
retries |
number of retries to make; defaults to
|
beforeRetry |
if given, an expression that will be evaluated
before each retry if the initial attempt fails; it is evaluated
in the same environment and with the same quoting semantics as
|
envir, enclos
|
see |
verbose |
Whether to output retries. |
Results of evaluating expr, including side-effects such
as variable assignments, if successful in retries retries.
If expr returns a "try-error" object (returned by
try()), it will be treated as an error. This behavior may
change in the future.
x <- 0 persistEvalQ({if((x<-x+1)<3) stop("x < 3") else x}, beforeRetry = {cat("Will try incrementing...\n")}) x <- 0 e <- quote(if((x<-x+1)<3) stop("x < 3") else x) persistEval(e, beforeRetry = quote(cat("Will try incrementing...\n")))x <- 0 persistEvalQ({if((x<-x+1)<3) stop("x < 3") else x}, beforeRetry = {cat("Will try incrementing...\n")}) x <- 0 e <- quote(if((x<-x+1)<3) stop("x < 3") else x) persistEval(e, beforeRetry = quote(cat("Will try incrementing...\n")))
This function prints the control list, including what it can control and the elements.
## S3 method for class 'control.list' print(x, ..., indent = "")## S3 method for class 'control.list' print(x, ..., indent = "")
x |
A list generated by a |
... |
Additional argument to print methods for individual settings. |
indent |
an argument for recursive calls, to facilitate indentation of nested lists. |
check.control.class, set.control.class
This function sets the class of the control list, with the default being the name of the calling function.
set.control.class( myname = as.character(ult(sys.calls(), 2)[[1L]]), control = get("control", pos = parent.frame()) )set.control.class( myname = as.character(ult(sys.calls(), 2)[[1L]]), control = get("control", pos = parent.frame()) )
myname |
Name of the class to set. |
control |
Control list. Defaults to the |
The control list with class set.
In earlier versions, OKnames and myname were autodetected. This capability has been deprecated and results in a warning issued once per session. They now need to be set explicitly.
check.control.class(), print.control.list()
This behaviour is not dissimilar to that of simplify2array(), but
it offers more robust handling of empty or NULL elements and never
promotes to a matrix or an array, making it suitable to be a column
of a data.frame.
simplify_simple( x, toNA = c("null", "empty", "keep"), empty = c("keep", "unlist"), ... )simplify_simple( x, toNA = c("null", "empty", "keep"), empty = c("keep", "unlist"), ... )
x |
an R |
toNA |
a character string indicating whether |
empty |
a character string indicating how empty lists should
be handled: either |
... |
additional arguments passed to |
an atomic vector or a list of the same length as x.
(x <- as.list(1:5)) stopifnot(identical(simplify_simple(x), 1:5)) x[3] <- list(NULL) # Put a NULL in place of 3. x stopifnot(identical(simplify_simple(x, FALSE), x)) # Can't be simplified without replacing the NULL. stopifnot(identical(simplify_simple(x), c(1L,2L,NA,4L,5L))) # NULL replaced by NA and simplified. x[[3]] <- integer(0) x stopifnot(identical(simplify_simple(x), x)) # A 0-length vector is not replaced by default, stopifnot(identical(simplify_simple(x, "empty"), c(1L,2L,NA,4L,5L))) # but can be. (x <- lapply(1:5, function(i) c(i,i+1L))) # Elements are vectors of equal length. simplify2array(x) # simplify2array() creates a matrix, stopifnot(identical(simplify_simple(x), x)) # but simplify_simple() returns a list.(x <- as.list(1:5)) stopifnot(identical(simplify_simple(x), 1:5)) x[3] <- list(NULL) # Put a NULL in place of 3. x stopifnot(identical(simplify_simple(x, FALSE), x)) # Can't be simplified without replacing the NULL. stopifnot(identical(simplify_simple(x), c(1L,2L,NA,4L,5L))) # NULL replaced by NA and simplified. x[[3]] <- integer(0) x stopifnot(identical(simplify_simple(x), x)) # A 0-length vector is not replaced by default, stopifnot(identical(simplify_simple(x, "empty"), c(1L,2L,NA,4L,5L))) # but can be. (x <- lapply(1:5, function(i) c(i,i+1L))) # Elements are vectors of equal length. simplify2array(x) # simplify2array() creates a matrix, stopifnot(identical(simplify_simple(x), x)) # but simplify_simple() returns a list.
A utility to facilitate argument completion of control lists.
snctrl(...)snctrl(...)
... |
The parameter list is updated dynamically as packages are loaded and unloaded. Their current list is given below. |
In and of itself, snctrl copies its named arguments into a
list. However, its argument list is updated dynamically as packages
are loaded, as are those of its reexports from other packages. This
is done using an API provided by helper functions. (See API?snctrl.)
This list is updated as packages are loaded and unloaded.
You may see messages along the lines of
The following object is masked from 'package:PKG': snctrl
when loading packages. They are benign.
snctrl updating.Helper functions used by packages to facilitate snctrl updating.
snctrl_names() update_snctrl(myname, arglists = NULL, callback = NULL) collate_controls(x = NULL, ...) UPDATE_MY_SCTRL_EXPR COLLATE_ALL_MY_CONTROLS_EXPRsnctrl_names() update_snctrl(myname, arglists = NULL, callback = NULL) collate_controls(x = NULL, ...) UPDATE_MY_SCTRL_EXPR COLLATE_ALL_MY_CONTROLS_EXPR
myname |
Name of the package defining the arguments. |
arglists |
A named list of argument name-default pairs. If the
list is not named, it is first passed through
|
callback |
A function with no arguments that updates the
packages own copy of |
x |
Either a function, a list of functions, or an
environment. If |
... |
Additional functions or lists of functions. |
UPDATE_MY_SCTRL_EXPR is a quoted expression meant to be passed directly to eval().
COLLATE_ALL_MY_CONTROLS_EXPR is a quoted expression meant to be passed directly to eval().
update_snctrl() has no return value and is used for its side-effects.
collate_controls() returns the combined list of name-default pairs of each function.
snctrl_names(): Typeset the currently defined list of
argument names by package and control function.
update_snctrl(): Typically called from .onLoad(), Update the
argument list of snctrl() to include additional argument names
associated with the package, and set a callback for the package
to update its own copy.
collate_controls(): Obtain and concatenate the argument lists of
specified functions or all functions starting with dQuote(control.) in
the environment.
UPDATE_MY_SCTRL_EXPR: A stored expression that, if evaluated, will
create a callback function update_my_snctrl() that will update
the client package's copy of snctrl().
COLLATE_ALL_MY_CONTROLS_EXPR: A stored expression that, if evaluated on
loading, will add arguments of the package's control.*()
functions to snctrl() and set the callback.
## Not run: # In the client package (outside any function): eval(UPDATE_MY_SCTRL_EXPR) ## End(Not run) ## Not run: # In the client package: .onLoad <- function(libame, pkgname){ # ... other code ... eval(statnet.common::COLLATE_ALL_MY_CONTROLS_EXPR) # ... other code ... } ## End(Not run)## Not run: # In the client package (outside any function): eval(UPDATE_MY_SCTRL_EXPR) ## End(Not run) ## Not run: # In the client package: .onLoad <- function(libame, pkgname){ # ... other code ... eval(statnet.common::COLLATE_ALL_MY_CONTROLS_EXPR) # ... other code ... } ## End(Not run)
split() method for array and matrix types on a margin.These methods split an array and matrix into a list of
arrays or matrices with the same number of dimensions
according to the specified margin.
## S3 method for class 'array' split(x, f, drop = FALSE, margin = NULL, ...) ## S3 method for class 'matrix' split(x, f, drop = FALSE, margin = NULL, ...)## S3 method for class 'array' split(x, f, drop = FALSE, margin = NULL, ...) ## S3 method for class 'matrix' split(x, f, drop = FALSE, margin = NULL, ...)
x |
|
f, drop
|
See help for |
margin |
Which margin of the array to split along. |
... |
Additional arguments to |
x <- diag(5) f <- rep(1:2, c(2,3)) split(x, f, margin=1) # Split rows. split(x, f, margin=2) # Split columns. # This is similar to how data frames are split: stopifnot(identical(split(x, f, margin=1), lapply(lapply(split(as.data.frame(x), f), as.matrix), unname)))x <- diag(5) f <- rep(1:2, c(2,3)) split(x, f, margin=1) # Split rows. split(x, f, margin=2) # Split columns. # This is similar to how data frames are split: stopifnot(identical(split(x, f, margin=1), lapply(lapply(split(as.data.frame(x), f), as.matrix), unname)))
Covariance matrices of variables with very different orders of magnitude can have very large ratios between their greatest and their least eigenvalues, causing them to appear to the algorithms to be near-singular when they are actually very much SPD. These functions first scale the matrix's rows and/or columns by its diagonal elements and then undo the scaling on the result.
ssolve(a, b, ..., snnd = TRUE) sginv(X, ..., snnd = TRUE) ginv_eigen(X, tol = sqrt(.Machine$double.eps), ...) xTAx_seigen(x, A, tol = sqrt(.Machine$double.eps), ...) srcond(x, ..., snnd = TRUE) snearPD(x, ...) xTAx_ssolve(x, A, ...) xTAx_qrssolve(x, A, tol = 1e-07, ...) sandwich_ssolve(A, B, ...)ssolve(a, b, ..., snnd = TRUE) sginv(X, ..., snnd = TRUE) ginv_eigen(X, tol = sqrt(.Machine$double.eps), ...) xTAx_seigen(x, A, tol = sqrt(.Machine$double.eps), ...) srcond(x, ..., snnd = TRUE) snearPD(x, ...) xTAx_ssolve(x, A, ...) xTAx_qrssolve(x, A, tol = 1e-07, ...) sandwich_ssolve(A, B, ...)
snnd |
assume that the matrix is symmetric non-negative definite (SNND). This typically entails scaling that converts covariance to correlation and use of eigendecomposition rather than singular-value decomposition. If it's "obvious" that the matrix is not SSND (e.g., negative diagonal elements), an error is raised. |
x, a, b, X, A, B, tol, ...
|
corresponding arguments of the wrapped functions. |
ginv_eigen() reimplements MASS::ginv() but using
eigendecomposition rather than SVD; this means that it is only
suitable for symmetric matrices, but that detection of negative
eigenvalues is more robust.
ssolve(), sginv(), sginv_eigen(), and snearPD() wrap
solve(), MASS::ginv(), ginv_eigen(), and Matrix::nearPD(),
respectively. srcond() returns the reciprocal condition number of
rcond() net of the above scaling. xTAx_ssolve(),
xTAx_qrssolve(), xTAx_seigen(), and sandwich_ssolve() wrap
the corresponding statnet.common functions.
x <- rnorm(2, sd=c(1,1e12)) x <- c(x, sum(x)) A <- matrix(c(1, 0, 1, 0, 1e24, 1e24, 1, 1e24, 1e24), 3, 3) stopifnot(all.equal( xTAx_qrssolve(x,A), structure(drop(x%*%sginv(A)%*%x), rank = 2L, nullity = 1L) )) x <- rnorm(2, sd=c(1,1e12)) x <- c(x, rnorm(1, sd=1e12)) A <- matrix(c(1, 0, 1, 0, 1e24, 1e24, 1, 1e24, 1e24), 3, 3) stopifnot(try(xTAx_qrssolve(x,A), silent=TRUE) == "Error in xTAx_qrssolve(x, A) : x is not in the span of A\n")x <- rnorm(2, sd=c(1,1e12)) x <- c(x, sum(x)) A <- matrix(c(1, 0, 1, 0, 1e24, 1e24, 1, 1e24, 1e24), 3, 3) stopifnot(all.equal( xTAx_qrssolve(x,A), structure(drop(x%*%sginv(A)%*%x), rank = 2L, nullity = 1L) )) x <- rnorm(2, sd=c(1,1e12)) x <- c(x, rnorm(1, sd=1e12)) A <- matrix(c(1, 0, 1, 0, 1e24, 1e24, 1, 1e24, 1e24), 3, 3) stopifnot(try(xTAx_qrssolve(x,A), silent=TRUE) == "Error in xTAx_qrssolve(x, A) : x is not in the span of A\n")
CITATION file utilities for Statnet packages (DEPRECATED)These functions automate citation generation for Statnet Project packages. They no longer appear to work with CRAN and are thus deprecated.
statnet.cite.head(pkg) statnet.cite.foot(pkg) statnet.cite.pkg(pkg)statnet.cite.head(pkg) statnet.cite.foot(pkg) statnet.cite.pkg(pkg)
pkg |
Name of the package whose citation is being generated. |
For statnet.cite.head and statnet.cite.foot, an object
of type citationHeader and citationFooter, respectively,
understood by the citation function, with package name
substituted into the template.
For statnet.cite.pkg, an object of class bibentry
containing a 'software manual' citation for the package constructed from the
current version and author information in the DESCRIPTION and a
template.
citation, citHeader, citFooter, bibentry
## Not run: statnet.cite.head("statnet.common") statnet.cite.pkg("statnet.common") statnet.cite.foot("statnet.common") ## End(Not run)## Not run: statnet.cite.head("statnet.common") statnet.cite.pkg("statnet.common") statnet.cite.foot("statnet.common") ## End(Not run)
This function uses information returned by packageDescription()
to construct a standard package startup message according to the
policy of the Statnet Project.
statnetStartupMessage(pkgname, friends = c(), nofriends = c())statnetStartupMessage(pkgname, friends = c(), nofriends = c())
pkgname |
Name of the package whose information is used. |
friends, nofriends
|
No longer used. |
A string containing the startup message, to be passed to the
packageStartupMessage() call or NULL, if policy
prescribes printing default startup message. (Thus, if
statnetStartupMessage() returns NULL, the calling package should
not call packageStartupMessage() at all.)
Earlier versions of this function printed a more expansive message. This may change again as the Statnet Project policy evolves.
packageDescription(), packageStartupMessage()
## Not run: .onAttach <- function(lib, pkg){ sm <- statnetStartupMessage("ergm") if(!is.null(sm)) packageStartupMessage(sm) } ## End(Not run)## Not run: .onAttach <- function(lib, pkg){ sm <- statnetStartupMessage("ergm") if(!is.null(sm)) packageStartupMessage(sm) } ## End(Not run)
An optimized function equivalent to sweep(x, 2, STATS) for a matrix
x.
sweep_cols.matrix(x, STATS, disable_checks = FALSE)sweep_cols.matrix(x, STATS, disable_checks = FALSE)
x |
a numeric matrix; |
STATS |
a numeric vector whose length equals to the number of columns
of |
disable_checks |
if |
A matrix of the same attributes as x.
x <- matrix(runif(1000), ncol=4) s <- 1:4 stopifnot(all.equal(sweep_cols.matrix(x, s), sweep(x, 2, s)))x <- matrix(runif(1000), ncol=4) s <- 1:4 stopifnot(all.equal(sweep_cols.matrix(x, s), sweep(x, 2, s)))
Typically generated by list_rhs.formula(), it contains, in
addition to a list of call() or similar objects, attributes
"sign" and "env", containing, respectively a vector of
signs that the terms had in the original formula and a list of
environments of the formula from which the term has been
extracted. Indexing and concatenation methods preserve these.
term_list(x, sign = +1, env = NULL) as.term_list(x, ...) ## S3 method for class 'term_list' as.term_list(x, ...) ## Default S3 method: as.term_list(x, sign = +1, env = NULL, ...) ## S3 method for class 'term_list' c(x, ...) ## S3 method for class 'term_list' x[i, ...] ## S3 method for class 'term_list' print(x, ...)term_list(x, sign = +1, env = NULL) as.term_list(x, ...) ## S3 method for class 'term_list' as.term_list(x, ...) ## Default S3 method: as.term_list(x, sign = +1, env = NULL, ...) ## S3 method for class 'term_list' c(x, ...) ## S3 method for class 'term_list' x[i, ...] ## S3 method for class 'term_list' print(x, ...)
x |
a list of terms or a term; a |
sign |
a vector specifying the signs associated with each term ( |
env |
a list specifying the environments, or NULL |
... |
additional arguments to methods |
i |
list index |
list_rhs.formula(), list_summands.call()
e1 <- new.env() f1 <- a~b+c environment(f1) <- e1 f2 <- ~-NULL+1 (l1 <- list_rhs.formula(f1)) (l2 <- list_rhs.formula(f2)) (l <- c(l1,l2)) (l <- c(l2[1], l1[2], l1[1], l1[1], l2[2]))e1 <- new.env() f1 <- a~b+c environment(f1) <- e1 f2 <- ~-NULL+1 (l1 <- list_rhs.formula(f1)) (l2 <- list_rhs.formula(f2)) (l <- c(l1,l2)) (l <- c(l2[1], l1[2], l1[1], l1[1], l2[2]))
Make a copy of an environment with just the selected objects.
trim_env(object, keep = NULL, ...) ## S3 method for class 'environment' trim_env(object, keep = NULL, ...) ## Default S3 method: trim_env(object, keep = NULL, ...)trim_env(object, keep = NULL, ...) ## S3 method for class 'environment' trim_env(object, keep = NULL, ...) ## Default S3 method: trim_env(object, keep = NULL, ...)
object |
An |
keep |
A character vector giving names of variables in the environment (including its ancestors) to copy over, defaulting to dropping all. Variables that cannot be resolved are silently ignored. |
... |
Additional arguments, passed on to lower-level methods. |
An object of the same type as object, with updated environment.
trim_env(environment): A method for environment objects.
trim_env(default): Default method, for objects such as formula and function that have environment() and environment()<- methods.
Extract or replace the ultimate (last) element of a vector or a list, or an element counting from the end.
ult(x, i = 1L) ult(x, i = 1L) <- valueult(x, i = 1L) ult(x, i = 1L) <- value
x |
a vector or a list. |
i |
index from the end of the list to extract or replace (where 1 is the last element, 2 is the penultimate element, etc.). |
value |
Replacement value for the |
An element of x.
Due to the way in which assigning to a function is
implemented in R, ult(x) <- e may be less efficient than
x[[length(x)]] <- e.
x <- 1:5 (last <- ult(x)) (penultimate <- ult(x, 2)) # 2nd last. (ult(x) <- 6) (ult(x, 2) <- 7) # 2nd last. xx <- 1:5 (last <- ult(x)) (penultimate <- ult(x, 2)) # 2nd last. (ult(x) <- 6) (ult(x, 2) <- 7) # 2nd last. x
rlang::check_dots_used() that issues a
warning that only lists argument names.This handler parses the error message produced by
rlang::check_dots_used(), extracting the names of the unused
arguments, and formats them into a more gentle warning message. It
relies on rlang maintaining its current format.
unused_dots_warning(e)unused_dots_warning(e)
e |
a condition object, typically not passed by the end-user; see example below. |
g <- function(b=NULL, ...){ invisible(force(b)) } f <- function(...){ rlang::check_dots_used(error = unused_dots_warning) g(...) } f() # OK f(b=2) # OK f(a=1, b=2, c=3) # Warning about a and c but not about bg <- function(b=NULL, ...){ invisible(force(b)) } f <- function(...){ rlang::check_dots_used(error = unused_dots_warning) g(...) } f() # OK f(b=2) # OK f(a=1, b=2, c=3) # Warning about a and c but not about b
TRUE in specified positions.This function is basically an inverse of which.
unwhich(which, n)unwhich(which, n)
which |
a numeric vector of indices to set to |
n |
total length of the output vector. |
A logical vector of length n whose elements listed in
which are set to TRUE, and whose other elements are set to
FALSE.
x <- as.logical(rbinom(10,1,0.5)) stopifnot(all(x == unwhich(which(x), 10)))x <- as.logical(rbinom(10,1,0.5)) stopifnot(all(x == unwhich(which(x), 10)))
A helper function to reorder vector v (if named) into order specified
by matching its names to the argument names
vector.namesmatch(v, names, errname = NULL)vector.namesmatch(v, names, errname = NULL)
v |
a vector (or list) with named elements, to be reorderd |
names |
a character vector of element names, corresponding to names of
|
errname |
optional, name to be reported in any error messages. default
to |
does some checking of appropriateness of arguments, and reorders v by
matching its names to character vector names
returns v, with elements reordered
earlier versions of this function did not order as advertiased
test<-list(c=1,b=2,a=3) vector.namesmatch(test,names=c('a','c','b'))test<-list(c=1,b=2,a=3) vector.namesmatch(test,names=c('a','c','b'))
A simple class for keeping track of the running mean and the sum of squared deviations from the mean for a vector.
Welford(dn, means, vars) ## S3 method for class 'Welford' update(object, newdata, ...)Welford(dn, means, vars) ## S3 method for class 'Welford' update(object, newdata, ...)
dn, means, vars
|
initialization of the Welford object: if |
object |
a |
newdata |
either a numeric vector of length |
... |
additional arguments to methods. |
an object of type Welford: a list with four elements:
n: Running number of observations
means: Running mean for each variable
SSDs: Running sum of squared deviations from the mean for each variable
vars: Running variance of each variable
update(Welford): Update a Welford object with new
data.
X <- matrix(rnorm(200), 20, 10) w0 <- Welford(10) w <- update(w0, X) stopifnot(isTRUE(all.equal(w$means, colMeans(X)))) stopifnot(isTRUE(all.equal(w$vars, apply(X,2,var)))) w <- update(w0, X[1:12,]) w <- update(w, X[13:20,]) stopifnot(isTRUE(all.equal(w$means, colMeans(X)))) stopifnot(isTRUE(all.equal(w$vars, apply(X,2,var)))) w <- Welford(12, colMeans(X[1:12,]), apply(X[1:12,], 2, var)) w <- update(w, X[13:20,]) stopifnot(isTRUE(all.equal(w$means, colMeans(X)))) stopifnot(isTRUE(all.equal(w$vars, apply(X,2,var))))X <- matrix(rnorm(200), 20, 10) w0 <- Welford(10) w <- update(w0, X) stopifnot(isTRUE(all.equal(w$means, colMeans(X)))) stopifnot(isTRUE(all.equal(w$vars, apply(X,2,var)))) w <- update(w0, X[1:12,]) w <- update(w, X[13:20,]) stopifnot(isTRUE(all.equal(w$means, colMeans(X)))) stopifnot(isTRUE(all.equal(w$vars, apply(X,2,var)))) w <- Welford(12, colMeans(X[1:12,]), apply(X[1:12,], 2, var)) w <- update(w, X[13:20,]) stopifnot(isTRUE(all.equal(w$means, colMeans(X)))) stopifnot(isTRUE(all.equal(w$vars, apply(X,2,var))))
A representation of a numeric matrix with row weights, represented
on either linear (linwmatrix) or logarithmic (logwmatrix)
scale.
logwmatrix( data = NA, nrow = 1, ncol = 1, byrow = FALSE, dimnames = NULL, w = NULL ) linwmatrix( data = NA, nrow = 1, ncol = 1, byrow = FALSE, dimnames = NULL, w = NULL ) is.wmatrix(x) is.logwmatrix(x) is.linwmatrix(x) as.linwmatrix(x, ...) as.logwmatrix(x, ...) ## S3 method for class 'linwmatrix' as.linwmatrix(x, ...) ## S3 method for class 'logwmatrix' as.linwmatrix(x, ...) ## S3 method for class 'logwmatrix' as.logwmatrix(x, ...) ## S3 method for class 'linwmatrix' as.logwmatrix(x, ...) ## S3 method for class 'matrix' as.linwmatrix(x, w = NULL, ...) ## S3 method for class 'matrix' as.logwmatrix(x, w = NULL, ...) ## S3 method for class 'wmatrix' print(x, ...) ## S3 method for class 'logwmatrix' print(x, ...) ## S3 method for class 'linwmatrix' print(x, ...) ## S3 method for class 'logwmatrix' compress_rows(x, ...) ## S3 method for class 'linwmatrix' compress_rows(x, ...) ## S3 method for class 'wmatrix' decompress_rows(x, target.nrows = NULL, ...) ## S3 method for class 'wmatrix' x[i, j, ..., drop = FALSE] ## S3 replacement method for class 'wmatrix' x[i, j, ...] <- valuelogwmatrix( data = NA, nrow = 1, ncol = 1, byrow = FALSE, dimnames = NULL, w = NULL ) linwmatrix( data = NA, nrow = 1, ncol = 1, byrow = FALSE, dimnames = NULL, w = NULL ) is.wmatrix(x) is.logwmatrix(x) is.linwmatrix(x) as.linwmatrix(x, ...) as.logwmatrix(x, ...) ## S3 method for class 'linwmatrix' as.linwmatrix(x, ...) ## S3 method for class 'logwmatrix' as.linwmatrix(x, ...) ## S3 method for class 'logwmatrix' as.logwmatrix(x, ...) ## S3 method for class 'linwmatrix' as.logwmatrix(x, ...) ## S3 method for class 'matrix' as.linwmatrix(x, w = NULL, ...) ## S3 method for class 'matrix' as.logwmatrix(x, w = NULL, ...) ## S3 method for class 'wmatrix' print(x, ...) ## S3 method for class 'logwmatrix' print(x, ...) ## S3 method for class 'linwmatrix' print(x, ...) ## S3 method for class 'logwmatrix' compress_rows(x, ...) ## S3 method for class 'linwmatrix' compress_rows(x, ...) ## S3 method for class 'wmatrix' decompress_rows(x, target.nrows = NULL, ...) ## S3 method for class 'wmatrix' x[i, j, ..., drop = FALSE] ## S3 replacement method for class 'wmatrix' x[i, j, ...] <- value
data, nrow, ncol, byrow, dimnames
|
passed to |
w |
row weights on the appropriate scale. |
x |
an object to be coerced or tested. |
... |
extra arguments, currently unused. |
target.nrows |
the approximate number of rows the uncompressed matrix should have; if not achievable exactly while respecting proportionality, a matrix with a slightly different number of rows will be constructed. |
i, j, value
|
rows and columns and values for extraction or
replacement; as |
drop |
Used for consistency with the generic. Ignored, and
always treated as |
An object of class linwmatrix/logwmatrix and wmatrix,
which is a matrix but also has an attribute w containing
row weights on the linear or the natural-log-transformed scale.
Note that wmatrix itself is an "abstract" class: you cannot
instantiate it.
Note that at this time, wmatrix is designed as, first and
foremost, as class for storing compressed data matrices, so most
methods that operate on matrices may not handle the weights
correctly and may even cause them to be lost.
rowweights, lrowweights, compress_rows
(m <- matrix(1:3, 2, 3, byrow=TRUE)) (m <- rbind(m, 3*m, 2*m, m)) (mlog <- as.logwmatrix(m)) (mlin <- as.linwmatrix(m)) (cmlog <- compress_rows(mlog)) (cmlin <- compress_rows(mlin)) stopifnot(all.equal(as.linwmatrix(cmlog),cmlin)) cmlog[2,] <- 1:3 (cmlog <- compress_rows(cmlog)) stopifnot(sum(rowweights(cmlog))==nrow(m)) (m3 <- matrix(c(1:3,(1:3)*2,(1:3)*3), 3, 3, byrow=TRUE)) (rowweights(m3) <- c(4, 2, 2)) stopifnot(all.equal(compress_rows(as.logwmatrix(m)), as.logwmatrix(m3),check.attributes=FALSE)) stopifnot(all.equal(rowweights(compress_rows(as.logwmatrix(m))), rowweights(as.logwmatrix(m3)),check.attributes=FALSE))(m <- matrix(1:3, 2, 3, byrow=TRUE)) (m <- rbind(m, 3*m, 2*m, m)) (mlog <- as.logwmatrix(m)) (mlin <- as.linwmatrix(m)) (cmlog <- compress_rows(mlog)) (cmlin <- compress_rows(mlin)) stopifnot(all.equal(as.linwmatrix(cmlog),cmlin)) cmlog[2,] <- 1:3 (cmlog <- compress_rows(cmlog)) stopifnot(sum(rowweights(cmlog))==nrow(m)) (m3 <- matrix(c(1:3,(1:3)*2,(1:3)*3), 3, 3, byrow=TRUE)) (rowweights(m3) <- c(4, 2, 2)) stopifnot(all.equal(compress_rows(as.logwmatrix(m)), as.logwmatrix(m3),check.attributes=FALSE)) stopifnot(all.equal(rowweights(compress_rows(as.logwmatrix(m))), rowweights(as.logwmatrix(m3)),check.attributes=FALSE))
Set or extract weighted matrix row weights
rowweights(x, ...) ## S3 method for class 'linwmatrix' rowweights(x, ...) ## S3 method for class 'logwmatrix' rowweights(x, ...) lrowweights(x, ...) ## S3 method for class 'logwmatrix' lrowweights(x, ...) ## S3 method for class 'linwmatrix' lrowweights(x, ...) rowweights(x, ...) <- value ## S3 replacement method for class 'linwmatrix' rowweights(x, update = TRUE, ...) <- value ## S3 replacement method for class 'logwmatrix' rowweights(x, update = TRUE, ...) <- value lrowweights(x, ...) <- value ## S3 replacement method for class 'linwmatrix' lrowweights(x, update = TRUE, ...) <- value ## S3 replacement method for class 'logwmatrix' lrowweights(x, update = TRUE, ...) <- value ## S3 replacement method for class 'matrix' rowweights(x, ...) <- value ## S3 replacement method for class 'matrix' lrowweights(x, ...) <- valuerowweights(x, ...) ## S3 method for class 'linwmatrix' rowweights(x, ...) ## S3 method for class 'logwmatrix' rowweights(x, ...) lrowweights(x, ...) ## S3 method for class 'logwmatrix' lrowweights(x, ...) ## S3 method for class 'linwmatrix' lrowweights(x, ...) rowweights(x, ...) <- value ## S3 replacement method for class 'linwmatrix' rowweights(x, update = TRUE, ...) <- value ## S3 replacement method for class 'logwmatrix' rowweights(x, update = TRUE, ...) <- value lrowweights(x, ...) <- value ## S3 replacement method for class 'linwmatrix' lrowweights(x, update = TRUE, ...) <- value ## S3 replacement method for class 'logwmatrix' lrowweights(x, update = TRUE, ...) <- value ## S3 replacement method for class 'matrix' rowweights(x, ...) <- value ## S3 replacement method for class 'matrix' lrowweights(x, ...) <- value
x |
a |
... |
extra arguments for methods. |
value |
weights to set, on the appropriate scale. |
update |
if |
For the accessor functions, the row weights or the row log-weights; otherwise, a weighted matrix with modified weights. The type of weight (linear or logarithmic) is converted to the required type and the type of weighting of the matrix is preserved.
Common quadratic forms
xTAx(x, A) xAxT(x, A) xTAx_solve(x, A, ...) xTAx_qrsolve(x, A, tol = 1e-07, ...) sandwich_solve(A, B, ...) xTAx_eigen(x, A, tol = sqrt(.Machine$double.eps), ...)xTAx(x, A) xAxT(x, A) xTAx_solve(x, A, ...) xTAx_qrsolve(x, A, tol = 1e-07, ...) sandwich_solve(A, B, ...) xTAx_eigen(x, A, tol = sqrt(.Machine$double.eps), ...)
x |
a vector |
A |
a square matrix |
... |
additional arguments to subroutines |
tol |
tolerance argument passed to the relevant subroutine |
B |
a square matrix |
These are somewhat inspired by emulator::quad.form.inv() and others.
xTAx(): Evaluate for vector and square
matrix .
xAxT(): Evaluate for vector and square
matrix .
xTAx_solve(): Evaluate for vector and
invertible matrix using solve().
xTAx_qrsolve(): Evaluate for vector and
matrix using QR decomposition and confirming that
is in the span of if is singular; returns rank
and nullity as attributes just in case subsequent calculations
(e.g., hypothesis test degrees of freedom) are affected.
sandwich_solve(): Evaluate for a
square matrix and invertible.
xTAx_eigen(): Evaluate for vector and
matrix (symmetric, nonnegative-definite) via
eigendecomposition; returns rank and nullity as attributes
just in case subsequent calculations (e.g., hypothesis test
degrees of freedom) are affected.
Decompose for diagonal matrix of
eigenvalues and orthogonal. Then .
Substituting,
for .