statnet.common/0000755000176200001440000000000014056677262013242 5ustar liggesusersstatnet.common/NAMESPACE0000644000176200001440000000623714056632754014466 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method("$",control.list) S3method("[",wmatrix) S3method("[<-",wmatrix) S3method("lrowweights<-",linwmatrix) S3method("lrowweights<-",logwmatrix) S3method("lrowweights<-",matrix) S3method("rowweights<-",linwmatrix) S3method("rowweights<-",logwmatrix) S3method("rowweights<-",matrix) S3method(as.control.list,control.list) S3method(as.control.list,list) S3method(as.linwmatrix,linwmatrix) S3method(as.linwmatrix,logwmatrix) S3method(as.linwmatrix,matrix) S3method(as.logwmatrix,linwmatrix) S3method(as.logwmatrix,logwmatrix) S3method(as.logwmatrix,matrix) S3method(compress_rows,data.frame) S3method(compress_rows,linwmatrix) S3method(compress_rows,logwmatrix) S3method(decompress_rows,compressed_rows_df) S3method(decompress_rows,wmatrix) S3method(diff,control.list) S3method(lrowweights,linwmatrix) S3method(lrowweights,logwmatrix) S3method(order,data.frame) S3method(order,default) S3method(order,matrix) S3method(print,control.list) S3method(print,diff.control.list) S3method(print,linwmatrix) S3method(print,logwmatrix) S3method(print,wmatrix) S3method(rowweights,linwmatrix) S3method(rowweights,logwmatrix) S3method(sort,data.frame) S3method(split,array) S3method(split,matrix) S3method(trim_env,default) S3method(trim_env,environment) export("EVL<-") export("NVL<-") export("lrowweights<-") export("rowweights<-") export("ult<-") export(.Deprecate_method) export(.Deprecate_once) export(COLLATE_ALL_MY_CONTROLS_EXPR) export(ERRVL) export(EVL) export(EVL2) export(EVL3) export(NVL) export(NVL2) export(NVL3) export(UPDATE_MY_SCTRL_EXPR) export(all_identical) export(append.rhs.formula) export(append_rhs.formula) export(as.control.list) export(as.linwmatrix) export(as.logwmatrix) export(attr) export(base_env) export(check.control.class) export(colMeans.mcmc.list) export(collate_controls) export(compress_rows) export(control.remap) export(deInf) export(decompress_rows) export(default_options) export(despace) export(empty_env) export(eval_lhs.formula) export(filter_rhs.formula) export(fixed.pval) export(forkTimeout) export(handle.controls) export(is.linwmatrix) export(is.logwmatrix) export(is.wmatrix) export(lapply.mcmc.list) export(linwmatrix) export(list_rhs.formula) export(list_summands.call) export(locate_function) export(locate_prefixed_function) export(log_mean_exp) export(log_sum_exp) export(logwmatrix) export(lrowweights) export(lweighted.mean) export(lweighted.var) export(message_print) export(nonsimp.update.formula) export(nonsimp_update.formula) export(once) export(opttest) export(order) export(paste.and) export(persistEval) export(persistEvalQ) export(rowweights) export(set.control.class) export(simplify_simple) export(snctrl) export(snctrl_names) export(statnet.cite.foot) export(statnet.cite.head) export(statnet.cite.pkg) export(statnetStartupMessage) export(sweep.mcmc.list) export(sweep_cols.matrix) export(term.list.formula) export(trim_env) export(ult) export(unwhich) export(update_snctrl) export(vector.namesmatch) importFrom(coda,as.mcmc) importFrom(coda,as.mcmc.list) importFrom(methods,is) importFrom(stats,as.formula) importFrom(utils,capture.output) importFrom(utils,getAnywhere) importFrom(utils,modifyList) useDynLib(statnet.common) statnet.common/LICENSE0000644000176200001440000000303614056622244014237 0ustar liggesusers-------------------------------------------------- License for the 'statnet' component package 'statnet.common' -------------------------------------------------- This software is distributed under the GPL-3 license. It is free, open source, and has the following attribution requirements (GPL Section 7): (a) you agree to retain in 'statnet.common' and any modifications to 'statnet.common' the copyright, author attribution and URL information as provided at http://statnet.org/attribution (b) you agree that 'statnet.common' and any modifications to 'statnet.common' will, when used, display the attribution: Based on 'statnet' project software (http://statnet.org). For license and citation information see http://statnet.org/attribution -------------------------------------------------- What does this mean? ==================== If you are modifying 'statnet.common' or adopting any source code from 'statnet.common' for use in another application, you must ensure that the copyright and attributions mentioned in the license above appear in the code of your modified version or application. These attributions must also appear when the package is loaded (e.g., via 'library' or 'require'). Enjoy! Mark S. Handcock, University of California-Los Angeles David R. Hunter, Penn State University Carter T. Butts, University of California-Irvine Steven M. Goodreau, University of Washington Pavel N. Krivitsky, University of New South Wales Martina Morris, University of Washington The 'statnet' development team Copyright 2007-2021 statnet.common/man/0000755000176200001440000000000014056633145014005 5ustar liggesusersstatnet.common/man/vector.namesmatch.Rd0000644000176200001440000000212613701734650017715 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.utilities.R \name{vector.namesmatch} \alias{vector.namesmatch} \title{reorder vector v into order determined by matching the names of its elements to a vector of names} \usage{ vector.namesmatch(v, names, errname = NULL) } \arguments{ \item{v}{a vector (or list) with named elements, to be reorderd} \item{names}{a character vector of element names, corresponding to names of \code{v}, specificying desired orering of \code{v}} \item{errname}{optional, name to be reported in any error messages. default to \code{deparse(substitute(v))}} } \value{ returns \code{v}, with elements reordered } \description{ A helper function to reorder vector \code{v} (if named) into order specified by matching its names to the argument \code{names} } \details{ does some checking of appropriateness of arguments, and reorders v by matching its names to character vector \code{names} } \note{ earlier versions of this function did not order as advertiased } \examples{ test<-list(c=1,b=2,a=3) vector.namesmatch(test,names=c('a','c','b')) } statnet.common/man/handle.controls.Rd0000644000176200001440000000324214047641642017373 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/control.utilities.R \name{handle.controls} \alias{handle.controls} \title{Handle standard \verb{control.*()} function semantics.} \usage{ handle.controls(myname, ...) } \arguments{ \item{myname}{the name of the calling function.} \item{...}{the \code{...} argument of the control function, if present.} } \value{ a list with formal arguments of the calling function. } \description{ This function takes the arguments of its caller (whose name should be passed explicitly), plus any \code{...} arguments and produces a control list based on the standard semantics of \verb{control.*()} functions, including handling deprecated arguments, identifying undefined arguments, and handling arguments that should be passed through \code{\link[=match.arg]{match.arg()}}. } \details{ The function behaves based on the information it acquires from the calling function. Specifically, \itemize{ \item The values of formal arguments (except \code{...}, if present) are taken from the environment of the calling function and stored in the list. \item If the calling function has a \code{...} argument \emph{and} defines an \code{old.controls} variable in its environment, then it remaps the names in \code{...} to their new names based on \code{old.controls}. In addition, if the value is a list with two elements, \code{action} and \code{message}, the standard deprecation message will have \code{message} appended to it and then be called with \code{action()}. \item If the calling function has a \code{match.arg.pars} in its environment, the arguments in that list are processed through \code{\link[=match.arg]{match.arg()}}. } } statnet.common/man/sweep_cols.matrix.Rd0000644000176200001440000000157413701734650017750 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/logspace.utils.R \name{sweep_cols.matrix} \alias{sweep_cols.matrix} \title{Suptract a elements of a vector from respective columns of a matrix} \usage{ sweep_cols.matrix(x, STATS, disable_checks = FALSE) } \arguments{ \item{x}{a numeric matrix;} \item{STATS}{a numeric vector whose length equals to the number of columns of \code{x}.} \item{disable_checks}{if \code{TRUE}, do not check that \code{x} is a numeric matrix and its number of columns matches the length of \code{STATS}; set in production code for a significant speed-up.} } \value{ A matrix of the same attributes as \code{x}. } \description{ An optimized function equivalent to \code{sweep(x, 2, STATS)} for a matrix \code{x}. } \examples{ x <- matrix(runif(1000), ncol=4) s <- 1:4 stopifnot(all.equal(sweep_cols.matrix(x, s), sweep(x, 2, s))) } statnet.common/man/set.control.class.Rd0000644000176200001440000000173713701734650017661 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/control.utilities.R \name{set.control.class} \alias{set.control.class} \title{Set the class of the control list} \usage{ set.control.class( myname = as.character(ult(sys.calls(), 2)[[1L]]), control = get("control", pos = parent.frame()) ) } \arguments{ \item{myname}{Name of the class to set.} \item{control}{Control list. Defaults to the \code{control} variable in the calling function.} } \value{ The control list with class set. } \description{ This function sets the class of the control list, with the default being the name of the calling function. } \note{ In earlier versions, \code{OKnames} and \code{myname} were autodetected. This capability has been deprecated and results in a warning issued once per session. They now need to be set explicitly. } \seealso{ \code{\link[=check.control.class]{check.control.class()}}, \code{\link[=print.control.list]{print.control.list()}} } \keyword{utilities} statnet.common/man/empty_env.Rd0000644000176200001440000000144014014030772016270 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/formula.utilities.R \name{empty_env} \alias{empty_env} \alias{base_env} \title{Replace an object's environment with a simple, static environment.} \usage{ empty_env(object) base_env(object) } \arguments{ \item{object}{An object with the \verb{environment()<-} method.} } \value{ An object of the same type as \code{object}, with updated environment. } \description{ Replace an object's environment with a simple, static environment. } \examples{ f <- y~x environment(f) # GlobalEnv environment(empty_env(f)) # EmptyEnv \dontshow{ stopifnot(identical(environment(empty_env(f)), emptyenv())) } environment(base_env(f)) # base package environment \dontshow{ stopifnot(identical(environment(base_env(f)), baseenv())) } } statnet.common/man/wmatrix.Rd0000644000176200001440000000726113711220501015756 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/wmatrix.R \name{wmatrix} \alias{wmatrix} \alias{logwmatrix} \alias{linwmatrix} \alias{is.wmatrix} \alias{is.logwmatrix} \alias{is.linwmatrix} \alias{as.linwmatrix} \alias{as.logwmatrix} \alias{as.linwmatrix.linwmatrix} \alias{as.linwmatrix.logwmatrix} \alias{as.logwmatrix.logwmatrix} \alias{as.logwmatrix.linwmatrix} \alias{as.linwmatrix.matrix} \alias{as.logwmatrix.matrix} \alias{print.wmatrix} \alias{print.logwmatrix} \alias{print.linwmatrix} \alias{compress_rows.logwmatrix} \alias{compress_rows.linwmatrix} \alias{decompress_rows.wmatrix} \alias{[.wmatrix} \alias{[<-.wmatrix} \title{A data matrix with row weights} \usage{ 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, ...) \method{as.linwmatrix}{linwmatrix}(x, ...) \method{as.linwmatrix}{logwmatrix}(x, ...) \method{as.logwmatrix}{logwmatrix}(x, ...) \method{as.logwmatrix}{linwmatrix}(x, ...) \method{as.linwmatrix}{matrix}(x, w = NULL, ...) \method{as.logwmatrix}{matrix}(x, w = NULL, ...) \method{print}{wmatrix}(x, ...) \method{print}{logwmatrix}(x, ...) \method{print}{linwmatrix}(x, ...) \method{compress_rows}{logwmatrix}(x, ...) \method{compress_rows}{linwmatrix}(x, ...) \method{decompress_rows}{wmatrix}(x, target.nrows = NULL, ...) \method{[}{wmatrix}(x, i, j, ..., drop = FALSE) \method{[}{wmatrix}(x, i, j, ...) <- value } \arguments{ \item{data, nrow, ncol, byrow, dimnames}{passed to \code{\link{matrix}}.} \item{w}{row weights on the appropriate scale.} \item{x}{an object to be coerced or tested.} \item{...}{extra arguments, currently unused.} \item{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.} \item{i, j, value}{rows and columns and values for extraction or replacement; as \code{\link{matrix}}.} \item{drop}{Used for consistency with the generic. Ignored, and always treated as \code{FALSE}.} } \value{ An object of class \code{linwmatrix}/\code{logwmatrix} and \code{wmatrix}, which is a \code{\link{matrix}} but also has an attribute \code{w} containing row weights on the linear or the natural-log-transformed scale. } \description{ A representation of a numeric matrix with row weights, represented on either linear (\code{linwmatrix}) or logarithmic (\code{logwmatrix}) scale. } \note{ Note that \code{wmatrix} itself is an "abstract" class: you cannot instantiate it. Note that at this time, \code{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. } \examples{ (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)) } \seealso{ \code{\link{rowweights}}, \code{\link{lrowweights}}, \code{\link{compress_rows}} } statnet.common/man/forkTimeout.Rd0000644000176200001440000000362613701734650016612 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.utilities.R \name{forkTimeout} \alias{forkTimeout} \title{Evaluate an \R expression with a hard time limit by forking a process} \usage{ forkTimeout( expr, timeout, unsupported = c("warning", "error", "message", "silent"), onTimeout = NULL ) } \arguments{ \item{expr}{expression to be evaluated.} \item{timeout}{number of seconds to wait for the expression to evaluate.} \item{unsupported}{a character vector of length 1 specifying how to handle a platform that does not support #ifndef windows \code{\link[parallel:mcparallel]{parallel::mcparallel()}}, #endif #ifdef windows \code{parallel::mcparallel()}, #endif \describe{ \item{\code{"warning"} or \code{"message"}}{Issue a warning or a message, respectively, then evaluate the expression without the time limit enforced.} \item{\code{"error"}}{Stop with an error.} \item{\code{"silent"}}{Evaluate the expression without the time limit enforced, without any notice.} } Partial matching is used.} \item{onTimeout}{Value to be returned on time-out.} } \value{ Result of evaluating \code{expr} if completed, \code{onTimeout} otherwise. } \description{ This function uses #ifndef windows \code{\link[parallel:mcparallel]{parallel::mcparallel()}}, #endif #ifdef windows \code{parallel::mcparallel()}, #endif so the time limit is not enforced on Windows. However, unlike functions using \code{\link[=setTimeLimit]{setTimeLimit()}}, the time limit is enforced even on native code. } \note{ \code{onTimeout} can itself be an expression, so it is, for example, possible to stop with an error by passing \code{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. } \examples{ forkTimeout({Sys.sleep(1); TRUE}, 2) # TRUE forkTimeout({Sys.sleep(1); TRUE}, 0.5) # NULL (except on Windows) } statnet.common/man/snctrl.Rd0000644000176200001440000000177614016053526015607 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/control.utilities.R \name{snctrl} \alias{snctrl} \title{Statnet Control} \usage{ snctrl(...) } \arguments{ \item{...}{The parameter list is updated dynamically as packages are loaded and unloaded. Their current list is given below.} } \description{ A utility to facilitate argument completion of control lists. } \details{ In and of itself, \code{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 \code{API?snctrl}.) } \note{ You may see messages along the lines of\preformatted{The following object is masked from 'package:PKG': snctrl } when loading packages. They are benign. } \section{Currently recognised control parameters}{ This list is updated as packages are loaded and unloaded. \Sexpr[results=rd,stage=render]{statnet.common::snctrl_names()} } statnet.common/man/attr.Rd0000644000176200001440000000113514053620112015231 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.utilities.R \name{attr} \alias{attr} \title{A wrapper for base::attr which defaults to exact matching.} \usage{ attr(x, which, exact = TRUE) } \arguments{ \item{x, which, exact}{as in \code{base::attr}, but with \code{exact} defaulting to \code{TRUE} in this implementation} } \value{ as in \code{base::attr} } \description{ A wrapper for base::attr which defaults to exact matching. } \examples{ x <- list() attr(x, "name") <- 10 base::attr(x, "n") stopifnot(is.null(attr(x, "n"))) base::attr(x, "n", exact = TRUE) } statnet.common/man/snctrl-API.Rd0000644000176200001440000000561514016053526016212 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/control.utilities.R \docType{data} \name{snctrl_names} \alias{snctrl_names} \alias{snctrl-API} \alias{update_snctrl} \alias{collate_controls} \alias{UPDATE_MY_SCTRL_EXPR} \alias{COLLATE_ALL_MY_CONTROLS_EXPR} \title{Helper functions used by packages to facilitate \code{\link{snctrl}} updating.} \format{ \code{UPDATE_MY_SCTRL_EXPR} is a quoted expression meant to be passed directly to \code{\link[=eval]{eval()}}. \code{COLLATE_ALL_MY_CONTROLS_EXPR} is a quoted expression meant to be passed directly to \code{\link[=eval]{eval()}}. } \usage{ snctrl_names() update_snctrl(myname, arglists = NULL, callback = NULL) collate_controls(x = NULL, ...) UPDATE_MY_SCTRL_EXPR COLLATE_ALL_MY_CONTROLS_EXPR } \arguments{ \item{myname}{Name of the package defining the arguments.} \item{arglists}{A named list of argument name-default pairs. If the list is not named, it is first passed through \code{\link[=collate_controls]{collate_controls()}}.} \item{callback}{A function with no arguments that updates the packages own copy of \code{\link[=snctrl]{snctrl()}}.} \item{x}{Either a function, a list of functions, or an environment. If \code{x} is an environment, all functions starting with dQuote(\code{control.}) are obtained.} \item{...}{Additional functions or lists of functions.} } \value{ \code{update_snctrl()} has no return value and is used for its side-effects. \code{collate_controls()} returns the combined list of name-default pairs of each function. } \description{ Helper functions used by packages to facilitate \code{\link{snctrl}} updating. } \section{Functions}{ \itemize{ \item \code{snctrl_names}: Typeset the currently defined list of argument names by package and control function. \item \code{update_snctrl}: Typically called from \code{\link[=.onLoad]{.onLoad()}}, Update the argument list of \code{\link[=snctrl]{snctrl()}} to include additional argument names associated with the package, and set a callback for the package to update its own copy. \item \code{collate_controls}: Obtain and concatenate the argument lists of specified functions or all functions starting with dQuote(\code{control.}) in the environment. \item \code{UPDATE_MY_SCTRL_EXPR}: A stored expression that, if evaluated, will create a callback function \code{update_my_snctrl()} that will update the client package's copy of \code{\link[=snctrl]{snctrl()}}. \item \code{COLLATE_ALL_MY_CONTROLS_EXPR}: A stored expression that, if evaluated on loading, will add arguments of the package's \verb{control.*()} functions to \code{\link[=snctrl]{snctrl()}} and set the callback. }} \examples{ \dontrun{ # In the client package (outside any function): eval(UPDATE_MY_SCTRL_EXPR) } \dontrun{ # In the client package: .onLoad <- function(libame, pkgname){ # ... other code ... eval(statnet.common::COLLATE_ALL_MY_CONTROLS_EXPR) # ... other code ... } } } \keyword{datasets} statnet.common/man/ult.Rd0000644000176200001440000000211713701734650015100 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.utilities.R \name{ult} \alias{ult} \alias{ult<-} \title{Extract or replace the \emph{ult}imate (last) element of a vector or a list, or an element counting from the end.} \usage{ ult(x, i = 1L) ult(x, i = 1L) <- value } \arguments{ \item{x}{a vector or a list.} \item{i}{index from the end of the list to extract or replace (where 1 is the last element, 2 is the penultimate element, etc.).} \item{value}{Replacement value for the \code{i}th element from the end.} } \value{ An element of \code{x}. } \description{ Extract or replace the \emph{ult}imate (last) element of a vector or a list, or an element counting from the end. } \note{ Due to the way in which assigning to a function is implemented in R, \code{ult(x) <- e} may be less efficient than \code{x[[length(x)]] <- e}. } \examples{ x <- 1:5 (last <- ult(x)) (penultimate <- ult(x, 2)) # 2nd last. \dontshow{ stopifnot(last==5) stopifnot(penultimate==4) } (ult(x) <- 6) (ult(x, 2) <- 7) # 2nd last. x \dontshow{ stopifnot(all(x == c(1:3, 7L, 6L))) } } statnet.common/man/logspace.utils.Rd0000644000176200001440000000522013701734650017226 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/logspace.utils.R \name{logspace.utils} \alias{logspace.utils} \alias{log_sum_exp} \alias{log_mean_exp} \alias{lweighted.mean} \alias{lweighted.var} \title{Utilities for performing calculations on logarithmic scale.} \usage{ log_sum_exp(logx, use_ldouble = FALSE) log_mean_exp(logx, use_ldouble = FALSE) lweighted.mean(x, logw) lweighted.var(x, logw) } \arguments{ \item{logx}{Numeric vector of \eqn{\log(x)}, the natural logarithms of the values to be summed or averaged.} \item{use_ldouble}{Whether to use \code{long double} precision in the calculation. If \code{TRUE}, 's C built-in \code{logspace_sum()} is used. If \code{FALSE}, the package's own implementation based on it is used, using \code{double} precision, which is (on most systems) several times faster, at the cost of precision.} \item{x}{Numeric vector of \eqn{x}, the (raw) values to be summed or averaged. For \code{lweighted.mean} and \code{lweighted.var}, \code{x} may also be a matrix, in which case the weighted mean will be computed for each column of \code{x} and the weighted variance-covariance matrix of the columns of \code{x} will be returned, respectively.} \item{logw}{Numeric vector of \eqn{\log(w)}, the natural logarithms of the weights.} } \value{ The functions return the equivalents of the following R expressions, but faster and with less loss of precision: \describe{ \item{\code{log_sum_exp(logx)}}{\code{log(sum(exp(logx)))}} \item{\code{log_mean_exp(logx)}}{\code{log(mean(exp(logx)))}} \item{\code{lweighted.mean(x,logw)}}{\code{sum(x*exp(logw))/sum(exp(logw))} for \code{x} scalar and \code{colSums(x*exp(logw))/sum(exp(logw))} for \code{x} matrix} \item{\code{lweighted.var(x,logw)}}{\code{crossprod(x*exp(logw/2))/sum(exp(logw))}} } } \description{ A small suite of functions to compute sums, means, and weighted means on logarithmic scale, minimizing loss of precision. } \examples{ logx <- rnorm(1000) stopifnot(all.equal(log(sum(exp(logx))), log_sum_exp(logx))) stopifnot(all.equal(log(mean(exp(logx))), log_mean_exp(logx))) x <- rnorm(1000) 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(m <- colSums(x*exp(logw))/sum(exp(logw)), lweighted.mean(x, logw), check.attributes=FALSE)) stopifnot(all.equal(crossprod(t(t(x)-m)*exp(logw/2))/sum(exp(logw)), lweighted.var(x, logw), check.attributes=FALSE)) } \author{ Pavel N. Krivitsky } \keyword{arith} statnet.common/man/diff.control.list.Rd0000644000176200001440000000246613756305506017650 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/control.utilities.R \name{diff.control.list} \alias{diff.control.list} \alias{print.diff.control.list} \title{Identify and the differences between two control lists.} \usage{ \method{diff}{control.list}(x, y = eval(call(class(x)[[1L]])), ignore.environment = TRUE, ...) \method{print}{diff.control.list}(x, ..., indent = "") } \arguments{ \item{x}{a \code{control.list}} \item{y}{a reference \code{control.list}; defaults to the default settings for \code{x}.} \item{ignore.environment}{whether environment for environment-bearing parameters (such as formulas and functions) should be considered when comparing.} \item{...}{Additional arguments to methods.} \item{indent}{an argument for recursive calls, to facilitate indentation of nested lists.} } \value{ An object of class \code{diff.control.list}: a named list with an element for each non-identical setting. The element is either itself a \code{diff.control.list} (if the setting is a control list) or a named list with elements \code{x} and \code{y}, containing \code{x}'s and \code{y}'s values of the parameter for that setting. } \description{ Identify and the differences between two control lists. } \section{Functions}{ \itemize{ \item \code{print.diff.control.list}: A print method. }} statnet.common/man/statnet.cite.Rd0000644000176200001440000000241313701734650016700 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cite.utilities.R \name{statnet.cite} \alias{statnet.cite} \alias{statnet.cite.head} \alias{statnet.cite.foot} \alias{statnet.cite.pkg} \title{\code{CITATION} file utilities for Statnet packages (DEPRECATED)} \usage{ statnet.cite.head(pkg) statnet.cite.foot(pkg) statnet.cite.pkg(pkg) } \arguments{ \item{pkg}{Name of the package whose citation is being generated.} } \value{ For \code{statnet.cite.head} and \code{statnet.cite.foot}, an object of type \code{citationHeader} and \code{citationFooter}, respectively, understood by the \code{\link{citation}} function, with package name substituted into the template. For \code{statnet.cite.pkg}, an object of class \code{\link{bibentry}} containing a 'software manual' citation for the package constructed from the current version and author information in the \code{DESCRIPTION} and a template. } \description{ These functions automate citation generation for Statnet Project packages. They no longer appear to work with CRAN and are thus deprecated. } \examples{ \dontrun{ statnet.cite.head("statnet.common") statnet.cite.pkg("statnet.common") statnet.cite.foot("statnet.common") } } \seealso{ citation, citHeader, citFooter, bibentry } \keyword{utilities} statnet.common/man/statnetStartupMessage.Rd0000644000176200001440000000272514056620171020647 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/startup.utilities.R \name{statnetStartupMessage} \alias{statnetStartupMessage} \title{Construct a "standard" startup message to be printed when the package is loaded.} \usage{ statnetStartupMessage(pkgname, friends = c(), nofriends = c()) } \arguments{ \item{pkgname}{Name of the package whose information is used.} \item{friends, nofriends}{No longer used.} } \value{ A string containing the startup message, to be passed to the \code{\link[=packageStartupMessage]{packageStartupMessage()}} call or \code{NULL}, if policy prescribes printing default startup message. (Thus, if \code{\link[=statnetStartupMessage]{statnetStartupMessage()}} returns \code{NULL}, the calling package should not call \code{\link[=packageStartupMessage]{packageStartupMessage()}} at all.) } \description{ This function uses information returned by \code{\link[=packageDescription]{packageDescription()}} to construct a standard package startup message according to the policy of the Statnet Project. } \note{ Earlier versions of this function printed a more expansive message. This may change again as the Statnet Project policy evolves. } \examples{ \dontrun{ .onAttach <- function(lib, pkg){ sm <- statnetStartupMessage("ergm") if(!is.null(sm)) packageStartupMessage(sm) } } } \seealso{ \code{\link[=packageDescription]{packageDescription()}}, \code{\link[=packageStartupMessage]{packageStartupMessage()}} } \keyword{utilities} statnet.common/man/unwhich.Rd0000644000176200001440000000125213701734650015740 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.utilities.R \name{unwhich} \alias{unwhich} \title{Construct a logical vector with \code{TRUE} in specified positions.} \usage{ unwhich(which, n) } \arguments{ \item{which}{a numeric vector of indices to set to \code{TRUE}.} \item{n}{total length of the output vector.} } \value{ A logical vector of length \code{n} whose elements listed in \code{which} are set to \code{TRUE}, and whose other elements are set to \code{FALSE}. } \description{ This function is basically an inverse of \code{\link{which}}. } \examples{ x <- as.logical(rbinom(10,1,0.5)) stopifnot(all(x == unwhich(which(x), 10))) } statnet.common/man/compress_rows.data.frame.Rd0000644000176200001440000000333213711220501021164 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.utilities.R \name{compress_rows.data.frame} \alias{compress_rows.data.frame} \alias{decompress_rows.compressed_rows_df} \title{"Compress" a data frame.} \usage{ \method{compress_rows}{data.frame}(x, ...) \method{decompress_rows}{compressed_rows_df}(x, ...) } \arguments{ \item{x}{For \code{compress_rows.data.frame} a \code{\link{data.frame}} to be compressed. For \code{decompress_rows.compress_rows_df} a \code{\link{list}} as returned by \code{compress_rows.data.frame}.} \item{...}{Additional arguments, currently unused.} } \value{ For \code{compress_rows.data.frame}, a \code{\link{list}} with three elements: \item{rows }{Unique rows of \code{x}} \item{frequencies }{A vector of the same length as the number or rows, giving the number of times the corresponding row is repeated } \item{ordering}{A vector such that if \code{c} is the compressed data frame, \code{c$rows[c$ordering,,drop=FALSE]} equals the original data frame, except for row names} \item{rownames}{Row names of \code{x}} For \code{decompress_rows.compressed_rows_df}, the original data frame. } \description{ \code{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. \code{decompress_rows.compressed_rows_df} reconstructs the original data frame. } \examples{ (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)) } \seealso{ \code{\link{data.frame}} } \keyword{manip} statnet.common/man/locate_function.Rd0000644000176200001440000000463713744633102017456 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/locator.R \name{locate_function} \alias{locate_function} \alias{locate_prefixed_function} \title{Locate a function with a given name and return it and its environment.} \usage{ locate_function(name, env = globalenv(), ...) locate_prefixed_function( name, prefix, errname, env = globalenv(), ..., call. = FALSE ) } \arguments{ \item{name}{a character string giving the function's name.} \item{env}{an \code{\link{environment}} where it should search first.} \item{...}{additional arguments to the warning and error warning messages. See Details.} \item{prefix}{a character string giving the prefix, so the searched-for function is \code{prefix.name}.} \item{errname}{a character string; if given, if the function is not found an error is raised, with \code{errname} prepended to the error message.} \item{call.}{a logical, whether the call (\code{locate_prefixed_function}) should be a part of the error message; defaults to \code{FALSE} (which is different from \code{\link[=stop]{stop()}}'s default).} } \value{ If the function is found, an unevaluated call of the form \code{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 \code{GlobalEnv}, only \code{FUNNAME} is returned. Otherwise, \code{NULL} is returned. } \description{ 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. } \details{ If the initial search fails, a search using \code{\link[=getAnywhere]{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 \code{\link[=getAnywhere]{getAnywhere()}} can be slow, past searches are cached. } \section{Functions}{ \itemize{ \item \code{locate_function}: a low-level function returning the reference to the function named \code{name}, or \code{NULL} if not found. \item \code{locate_prefixed_function}: a helper function that searches for a function of the form \code{prefix.name} and produces an informative error message if not found. }} \examples{ # Locate a random function in base. locate_function(".row_names_info") } statnet.common/man/fixed.pval.Rd0000644000176200001440000000270614045135346016337 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/string.utilities.R \name{fixed.pval} \alias{fixed.pval} \title{Format a p-value in fixed notation.} \usage{ fixed.pval( pv, digits = max(1, getOption("digits") - 2), eps = 10^-digits, na.form = "NA", ... ) } \arguments{ \item{pv, digits, eps, na.form, ...}{see \code{\link[=format.pval]{format.pval()}}.} } \value{ A character vector. } \description{ This is a thin wrapper around \code{\link[=format.pval]{format.pval()}} that guarantees fixed (not scientific) notation, links (by default) the \code{eps} argument to the \code{digits} argument and vice versa, and sets \code{nsmall} to equal \code{digits}. } \examples{ pvs <- 10^((0:-12)/2) # Jointly: fpf <- fixed.pval(pvs, digits = 3) fpf format.pval(pvs, digits = 3) # compare \dontshow{ stopifnot(all(fpf == c("1.000", "0.316", "0.100", "0.032", "0.010", "0.003", "0.001", "<0.001", "<0.001", "<0.001", "<0.001", "<0.001", "<0.001"))) } # Individually: fpf <- sapply(pvs, fixed.pval, digits = 3) fpf sapply(pvs, format.pval, digits = 3) # compare \dontshow{ stopifnot(all(fpf == c("1.000", "0.316", "0.100", "0.032", "0.010", "0.003", "0.001", "<0.001", "<0.001", "<0.001", "<0.001", "<0.001", "<0.001"))) } # Control eps: fpf <- sapply(pvs, fixed.pval, eps = 1e-3) fpf \dontshow{ stopifnot(all(fpf == c("1.000", "0.316", "0.100", "0.032", "0.010", "0.003", "0.001", "<0.001", "<0.001", "<0.001", "<0.001", "<0.001", "<0.001"))) } } statnet.common/man/default_options.Rd0000644000176200001440000000177013744456436017511 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/startup.utilities.R \name{default_options} \alias{default_options} \title{Set \code{\link[=options]{options()}} according to a named list, skipping those already set.} \usage{ default_options(...) } \arguments{ \item{...}{see \code{\link[=options]{options()}}: either a list of \code{name=value} pairs or a single unnamed argument giving a named list of options to set.} } \value{ The return value is same as that of \code{\link[=options]{options()}} (omitting options already set). } \description{ This function can be useful for setting default options, which do not override options set elsewhere. } \examples{ 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) } statnet.common/man/split.array.Rd0000644000176200001440000000243513701734650016547 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.utilities.R \name{split.array} \alias{split.array} \alias{split.matrix} \title{A \code{\link[=split]{split()}} method for \code{\link{array}} and \code{\link{matrix}} types on a margin.} \usage{ \method{split}{array}(x, f, drop = FALSE, margin = NULL, ...) \method{split}{matrix}(x, f, drop = FALSE, margin = NULL, ...) } \arguments{ \item{x}{A \code{\link{matrix}} or an \code{\link{array}}.} \item{f, drop}{See help for \code{\link[=split]{split()}}. Note that \code{drop} here is \emph{not} for array dimensions: these are always preserved.} \item{margin}{Which margin of the array to split along. \code{NULL} splits as \code{\link{split.default}}, dropping dimensions.} \item{...}{Additional arguments to \code{\link[=split]{split()}}.} } \description{ These methods split an \code{\link{array}} and \code{\link{matrix}} into a list of arrays or matrices with the same number of dimensions according to the specified margin. } \examples{ 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))) } statnet.common/man/deprecation-utilities.Rd0000644000176200001440000000276414056633145020613 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/deprecation_utils.R \name{deprecation-utilities} \alias{deprecation-utilities} \alias{.Deprecate_once} \alias{.Deprecate_method} \title{Utilities to help with deprecating functions.} \usage{ .Deprecate_once(...) .Deprecate_method(generic, class) } \arguments{ \item{...}{arguments passed to \code{\link[=.Deprecated]{.Deprecated()}}.} \item{generic, class}{strings giving the generic function name and class name of the function to be deprecated.} } \description{ \code{.Deprecate_once} calls \code{\link[=.Deprecated]{.Deprecated()}}, passing all its arguments through, but only the first time it's called. \code{.Deprecate_method} calls \code{\link[=.Deprecated]{.Deprecated()}}, but only if a method has been called by name, i.e., \code{\var{METHOD}.\var{CLASS}}. Like \code{.Deprecate_once} it only issues a warning the first time. } \examples{ \dontrun{ options(warn=1) # Print warning immediately after the call. f <- function(){ .Deprecate_once("new_f") } f() # Deprecation warning f() # No deprecation warning } \dontrun{ 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. } } statnet.common/man/mcmc-utilities.Rd0000644000176200001440000000420013701734650017217 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mcmc-utils.R \name{mcmc-utilities} \alias{mcmc-utilities} \alias{colMeans.mcmc.list} \alias{sweep.mcmc.list} \alias{lapply.mcmc.list} \title{Utility operations for \code{\link{mcmc.list}} objects} \usage{ colMeans.mcmc.list(x, ...) sweep.mcmc.list(x, STATS, FUN = "-", check.margin = TRUE, ...) lapply.mcmc.list(X, FUN, ...) } \arguments{ \item{x}{a \code{\link{mcmc.list}} object.} \item{\dots}{additional arguments to \code{\link{colMeans}} or \code{\link{sweep}}.} \item{STATS, FUN, check.margin}{See help for \code{\link{sweep}}.} \item{X}{An \code{\link{mcmc.list}} object.} } \value{ \code{colMeans.mcmc} returns a vector with length equal to the number of mcmc chains in \code{x} with the mean value for each chain. \code{sweep.mcmc.list} returns an appropriately modified version of \code{x} \code{lapply.mcmc.list} returns an \code{\link{mcmc.list}} each of whose chains had been passed through \code{FUN}. } \description{ \code{colMeans.mcmc.list} is a "method" for (non-generic) \code{\link{colMeans}} applicable to \code{\link{mcmc.list}} objects. \code{sweep.mcmc.list} is a "method" for (non-generic) \code{\link{sweep}} applicable to \code{\link{mcmc.list}} objects. \code{lapply.mcmc.list} is a "method" for (non-generic) \code{\link{lapply}} applicable to \code{\link{mcmc.list}} objects. } \examples{ data(line, package="coda") summary(line) # coda colMeans.mcmc.list(line) # "Method" \dontshow{ stopifnot(isTRUE(all.equal(summary(line)$statistics[,"Mean"],colMeans.mcmc.list(line)))) } data(line, package="coda") colMeans.mcmc.list(line)-1:3 colMeans.mcmc.list(sweep.mcmc.list(line, 1:3)) \dontshow{ stopifnot(isTRUE(all.equal(colMeans.mcmc.list(sweep.mcmc.list(line, 1:3)), colMeans.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))) \dontshow{ stopifnot(isTRUE(all.equal(colMeans.mcmc.list(line)[c(2,3,1)],colMeans.mcmc.list(lapply.mcmc.list(line, `[`,,c(2,3,1)))))) } } \seealso{ \code{\link{colMeans}}, \code{\link{mcmc.list}} \code{\link{sweep}} \code{\link{lapply}} } statnet.common/man/once.Rd0000644000176200001440000000506013701734650015220 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.utilities.R \name{once} \alias{once} \title{Evaluate a function once for a given input.} \usage{ once(f, expire_after = Inf, max_entries = Inf) } \arguments{ \item{f}{A function to modify.} \item{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.} \item{max_entries}{The number of distinct configurations to remember. If not \code{Inf}, \emph{earliest-inserted} configurations will be removed from the database when capacity is exceeded. (This exact behavior may change in the future.)} } \description{ This is a \code{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. } \details{ Each modified function instance returned by \code{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 \code{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. } \note{ Because the function needs to test whether a particular configuration of arguments have already been used, do not rely on lazy evaluation behaviour. } \examples{ 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. } statnet.common/man/NVL.Rd0000644000176200001440000000626413701734650014742 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.utilities.R \name{NVL} \alias{NVL} \alias{NVL2} \alias{NVL3} \alias{EVL} \alias{EVL2} \alias{EVL3} \alias{NVL<-} \alias{EVL<-} \title{Convenience functions for handling \code{\link{NULL}} objects.} \usage{ 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) <- value } \arguments{ \item{\dots, test}{expressions to be tested.} \item{notnull}{expression to be returned if \code{test} is not \code{NULL}.} \item{null}{expression to be returned if \code{test} is \code{NULL}.} \item{x}{an object to be overwritten if \code{\link{NULL}}.} \item{value}{new value for \code{x}.} } \description{ Convenience functions for handling \code{\link{NULL}} objects. } \section{Functions}{ \itemize{ \item \code{NVL}: Inspired by SQL function \code{NVL}, returns the first argument that is not \code{NULL}, or \code{NULL} if all arguments are \code{NULL}. \item \code{NVL2}: Inspired by Oracle SQL function \code{NVL2}, returns the second argument if the first argument is not \code{NULL} and the third argument if the first argument is \code{NULL}. The third argument defaults to \code{NULL}, so \code{NVL2(a, b)} can serve as shorthand for \code{(if(!is.null(a)) b)}. \item \code{NVL3}: Inspired by Oracle SQL \code{NVL2} function and \code{magittr} \code{\%>\%} operator, behaves as \code{NVL2} but \code{.}s in the second argument are substituted with the first argument. \item \code{EVL}: As \code{NVL}, but for any objects of length 0 (\emph{E}mpty) rather than just \code{NULL}. Note that if no non-zero-length arguments are given, \code{NULL} is returned. \item \code{EVL2}: As \code{NVL2}, but for any objects of length 0 (\emph{E}mpty) rather than just \code{NULL}. \item \code{EVL3}: As \code{NVL3}, but for any objects of length 0 (\emph{E}mpty) rather than just \code{NULL}. \item \code{NVL<-}: Assigning to \code{NVL} overwrites its first argument if that argument is \code{\link{NULL}}. Note that it will \emph{always} return the right-hand-side of the assignment (\code{value}), regardless of what \code{x} is. \item \code{EVL<-}: As assignment to \code{NVL}, but for any objects of length 0 (\emph{E}mpty) rather than just \code{NULL}. }} \note{ Whenever possible, these functions use lazy evaluation, so, for example \code{NVL(1, stop("Error!"))} will never evaluate the \code{\link{stop}} call and will not produce an error, whereas \code{NVL(NULL, stop("Error!"))} would. } \examples{ 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 1 } \seealso{ \code{\link{NULL}}, \code{\link[base]{is.null}}, \code{\link[base]{if}} } \keyword{utilities} statnet.common/man/paste.and.Rd0000644000176200001440000000167713701734650016163 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/string.utilities.R \name{paste.and} \alias{paste.and} \title{Concatenates the elements of a vector (optionaly enclosing them in quotation marks or parentheses) adding appropriate punctuation and conjunctions.} \usage{ paste.and(x, oq = "", cq = "", con = "and") } \arguments{ \item{x}{A vector.} \item{oq}{Opening quotation symbol. (Defaults to none.)} \item{cq}{Closing quotation symbol. (Defaults to none.)} \item{con}{Conjunction to be used if \code{length(x)>1}. (Defaults to "and".)} } \value{ A string with the output. } \description{ A vector \code{x} becomes "\code{x[1]}", "\code{x[1]} and \code{x[2]}", or "\code{x[1]}, \code{x[2]}, and \code{x[3]}", depending on the langth of \code{x}. } \examples{ 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')) } \seealso{ paste, cat } \keyword{utilities} statnet.common/man/compress_rows.Rd0000644000176200001440000000141613711220501017164 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/wmatrix.R \name{compress_rows} \alias{compress_rows} \alias{decompress_rows} \title{A generic function to compress a row-weighted table} \usage{ compress_rows(x, ...) decompress_rows(x, ...) } \arguments{ \item{x}{a weighted matrix or data frame.} \item{...}{extra arguments for methods.} } \value{ For \code{compress_rows} A weighted matrix or data frame of the same type with duplicated rows removed and weights updated appropriately. } \description{ 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). } statnet.common/man/deInf.Rd0000644000176200001440000000130013701734650015312 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.utilities.R \name{deInf} \alias{deInf} \title{Truncate values of high magnitude in a vector.} \usage{ deInf(x, replace = 1/.Machine$double.eps) } \arguments{ \item{x}{a numeric or integer vector.} \item{replace}{a number or a string \code{"maxint"} or \code{"intmax"}.} } \value{ Returns \code{x} with elements whose magnitudes exceed \code{replace} replaced replaced by \code{replace} (or its negation). If \code{replace} is \code{"maxint"} or \code{"intmax"}, \code{.Machine$integer.max} is used instead. \code{NA} and \code{NAN} values are preserved. } \description{ Truncate values of high magnitude in a vector. } statnet.common/man/opttest.Rd0000644000176200001440000000220413701734650015773 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.utilities.R \name{opttest} \alias{opttest} \title{Optionally test code depending on environment variable.} \usage{ opttest( expr, testname = NULL, testvar = "ENABLE_statnet_TESTS", yesvals = c("y", "yes", "t", "true", "1"), lowercase = TRUE ) } \arguments{ \item{expr}{An expression to be evaluated only if \code{testvar} is set to a non-empty value.} \item{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.} \item{testvar}{Environment variable name. If set to one of the \code{yesvals}, \code{expr} is run. Otherwise, an optional message is printed.} \item{yesvals}{A character vector of strings considered affirmative values for \code{testvar}.} \item{lowercase}{Whether to convert the value of \code{testvar} to lower case before comparing it to \code{yesvals}.} } \description{ A convenience wrapper to run code based on whether an environment variable is defined. } \keyword{debugging} \keyword{environment} \keyword{utilities} statnet.common/man/check.control.class.Rd0000644000176200001440000000435513770731134020142 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/control.utilities.R \name{check.control.class} \alias{check.control.class} \title{Ensure that the class of the control list is one of those that can be used by the calling function} \usage{ 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()) ) } \arguments{ \item{OKnames}{List of control function names which are acceptable.} \item{myname}{Name of the calling function (used in the error message).} \item{control}{The control list or a list to be converted to a control list using \code{control.myname()}. Defaults to the \code{control} variable in the calling function. See Details for detailed behavior.} } \value{ A valid control list for the function in which it is to be used. If \code{control} argument is missing, it will also overwrite the variable \code{control} in the calling environment with it. } \description{ This function converts an ordinary \code{list} into a control list (if needed) and checks that the control list passed is appropriate for the function to be controlled. } \details{ \code{check.control.class()} performs the check by looking up the class of the \code{control} argument (defaulting to the \code{control} variable in the calling function) and checking if it matches a list of acceptable given by \code{OKnames}. Before performing any checks, the \code{control} argument (including the default) will be converted to a control list by calling \code{\link[=as.control.list]{as.control.list()}} on it with the first element of \code{OKnames} to construct the control function. If \code{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. } \note{ In earlier versions, \code{OKnames} and \code{myname} were autodetected. This capability has been deprecated and results in a warning issued once per session. They now need to be set explicitly. } \seealso{ \code{\link[=set.control.class]{set.control.class()}}, \code{\link[=print.control.list]{print.control.list()}}, \code{\link[=as.control.list]{as.control.list()}} } \keyword{utilities} statnet.common/man/persistEval.Rd0000644000176200001440000000406213701734650016576 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.utilities.R \name{persistEval} \alias{persistEval} \alias{persistEvalQ} \title{Evaluate an expression, restarting on error} \usage{ 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 ) } \arguments{ \item{expr}{an expression to be retried; note the difference between \code{\link[=eval]{eval()}} and \code{\link[=evalq]{evalq()}}.} \item{retries}{number of retries to make; defaults to \code{"eval.retries"} option, or 5.} \item{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 \code{expr}, but its errors are not handled.} \item{envir, enclos}{see \code{\link[=eval]{eval()}}.} \item{verbose}{Whether to output retries.} } \value{ Results of evaluating \code{expr}, including side-effects such as variable assignments, if successful in \code{retries} retries. } \description{ A pair of functions paralleling \code{\link[=eval]{eval()}} and \code{\link[=evalq]{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. } \note{ If \code{expr} returns a \code{"try-error"} object (returned by \code{\link[=try]{try()}}), it will be treated as an error. This behavior may change in the future. } \examples{ 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"))) } statnet.common/man/despace.Rd0000644000176200001440000000057613701734650015707 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/string.utilities.R \name{despace} \alias{despace} \title{A one-line function to strip whitespace from its argument.} \usage{ despace(s) } \arguments{ \item{s}{a character vector.} } \description{ A one-line function to strip whitespace from its argument. } \examples{ stopifnot(despace("\n \t ")=="") } statnet.common/man/ERRVL.Rd0000644000176200001440000000271613701734650015173 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.utilities.R \name{ERRVL} \alias{ERRVL} \title{Return the first argument passed (out of any number) that is not a \code{try-error} (result of \code{\link[base]{try}} encountering an error.} \usage{ ERRVL(...) } \arguments{ \item{\dots}{Expressions to be tested; usually outputs of \code{\link[base]{try}}.} } \value{ The first argument that is not a \code{try-error}. Stops with an error if all are. } \description{ This function is inspired by \code{\link{NVL}}, and simply returns the first argument that is not a \code{try-error}, raising an error if all arguments are \code{try-error}s. } \note{ This function uses lazy evaluation, so, for example \code{ERRVL(1, stop("Error!"))} will never evaluate the \code{\link{stop}} call and will not produce an error, whereas \code{ERRVL(try(solve(0)), stop("Error!"))} would. In addition, all expressions after the first may contain a \code{.}, which is substituted with the \code{try-error} object returned by the previous expression. } \examples{ print(ERRVL(1,2,3)) # 1 print(ERRVL(try(solve(0)),2,3)) # 2 print(ERRVL(1, stop("Error!"))) # No error \dontrun{ # 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: ", .))) } } \seealso{ \code{\link[base]{try}}, \code{\link[base]{inherits}} } \keyword{utilities} statnet.common/man/control.remap.Rd0000644000176200001440000000155013701734650017057 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/control.utilities.R \name{control.remap} \alias{control.remap} \title{Overwrite control parameters of one configuration with another.} \usage{ control.remap(control, from, to) } \arguments{ \item{control}{An object of class \code{control.list}.} \item{from}{Prefix of the source of control parameters.} \item{to}{Prefix of the destination of control parameters.} } \value{ An \code{control.list} object. } \description{ Given a \code{control.list}, and two prefixes, \code{from} and \code{to}, overwrite the elements starting with \code{to} with the corresponding elements starting with \code{from}. } \examples{ (l <- set.control.class("test", list(a.x=1, a.y=2))) control.remap(l, "a", "b") } \seealso{ \code{\link{print.control.list}} } \author{ Pavel N. Krivitsky } \keyword{utilities} statnet.common/man/message_print.Rd0000644000176200001440000000140613701734650017134 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/string.utilities.R \name{message_print} \alias{message_print} \title{\code{\link{print}} objects to the \code{\link{message}} output.} \usage{ message_print(..., messageArgs = NULL) } \arguments{ \item{...}{arguments to \code{\link{print}}.} \item{messageArgs}{a list of arguments to be passed directly to \code{\link{message}}.} } \description{ A thin wrapper around \code{\link{print}} that captures its output and prints it as a \code{\link{message}}, usually to STDERR. } \examples{ 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)) # Silenced } statnet.common/man/simplify_simple.Rd0000644000176200001440000000410414004655074017476 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.utilities.R \name{simplify_simple} \alias{simplify_simple} \title{Convert a list to an atomic vector if it consists solely of atomic elements of length 1.} \usage{ simplify_simple( x, toNA = c("null", "empty", "keep"), empty = c("keep", "unlist"), ... ) } \arguments{ \item{x}{an R \code{\link{list}} to be simplified.} \item{toNA}{a character string indicating whether \code{NULL} entries (if \code{"null"}) or 0-length entries including \code{NULL} (if \code{"empty"}) should be replaced with \code{NA}s before attempting conversion; specifying \code{keep} or \code{FALSE} leaves them alone (typically preventing conversion).} \item{empty}{a character string indicating how empty lists should be handled: either \code{"keep"}, in which case they are unchanged or \code{"unlist"}, in which cases they are unlisted (typically to \code{NULL}).} \item{...}{additional arguments passed to \code{\link[=unlist]{unlist()}}.} } \value{ an atomic vector or a list of the same length as \code{x}. } \description{ This behaviour is not dissimilar to that of \code{\link[=simplify2array]{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 \code{\link{data.frame}}. } \examples{ (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. } statnet.common/man/sort.data.frame.Rd0000644000176200001440000000330713701734650017266 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.utilities.R \name{order} \alias{order} \alias{order.default} \alias{order.data.frame} \alias{order.matrix} \alias{sort.data.frame} \title{Implement the \code{\link{sort}} and \code{\link{order}} methods for \code{\link{data.frame}} and \code{\link{matrix}}, sorting it in lexicographic order.} \usage{ order(..., na.last = TRUE, decreasing = FALSE) \method{order}{default}(..., na.last = TRUE, decreasing = FALSE) \method{order}{data.frame}(..., na.last = TRUE, decreasing = FALSE) \method{order}{matrix}(..., na.last = TRUE, decreasing = FALSE) \method{sort}{data.frame}(x, decreasing = FALSE, ...) } \arguments{ \item{\dots}{Ignored for \code{sort}. For \code{order}, first argument is the data frame to be ordered. (This is needed for compatibility with \code{\link[base]{order}}.)} \item{na.last}{See \code{\link[base]{order}} documentation.} \item{decreasing}{Whether to sort in decreasing order.} \item{x}{A \code{\link{data.frame}} to sort.} } \value{ For \code{sort}, a data frame, sorted lexicographically. For \code{order}, a permutation \code{I} (of a vector \code{1:nrow(x)}) such that \code{x[I,,drop=FALSE]} equals \code{x} ordered lexicographically. } \description{ 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.. } \examples{ data(iris) head(iris) head(order(iris)) head(sort(iris)) stopifnot(identical(sort(iris),iris[order(iris),])) } \seealso{ \code{\link{data.frame}}, \code{\link{sort}}, \code{\link{order}}, \code{\link{matrix}} } \keyword{manip} statnet.common/man/wmatrix_weights.Rd0000644000176200001440000000375313701734650017530 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/wmatrix.R \name{wmatrix_weights} \alias{wmatrix_weights} \alias{rowweights} \alias{rowweights.linwmatrix} \alias{rowweights.logwmatrix} \alias{lrowweights} \alias{lrowweights.logwmatrix} \alias{lrowweights.linwmatrix} \alias{rowweights<-} \alias{rowweights<-.linwmatrix} \alias{rowweights<-.logwmatrix} \alias{lrowweights<-} \alias{lrowweights<-.linwmatrix} \alias{lrowweights<-.logwmatrix} \alias{rowweights<-.matrix} \alias{lrowweights<-.matrix} \title{Set or extract weighted matrix row weights} \usage{ rowweights(x, ...) \method{rowweights}{linwmatrix}(x, ...) \method{rowweights}{logwmatrix}(x, ...) lrowweights(x, ...) \method{lrowweights}{logwmatrix}(x, ...) \method{lrowweights}{linwmatrix}(x, ...) rowweights(x, ...) <- value \method{rowweights}{linwmatrix}(x, update = TRUE, ...) <- value \method{rowweights}{logwmatrix}(x, update = TRUE, ...) <- value lrowweights(x, ...) <- value \method{lrowweights}{linwmatrix}(x, update = TRUE, ...) <- value \method{lrowweights}{logwmatrix}(x, update = TRUE, ...) <- value \method{rowweights}{matrix}(x, ...) <- value \method{lrowweights}{matrix}(x, ...) <- value } \arguments{ \item{x}{a \code{\link{linwmatrix}}, a \code{\link{logwmatrix}}, or a \code{\link{matrix}}; a \code{\link{matrix}} is coerced to a weighted matrix of an appropriate type.} \item{...}{extra arguments for methods.} \item{value}{weights to set, on the appropriate scale.} \item{update}{if \code{TRUE} (the default), the old weights are updated with the new weights (i.e., corresponding weights are multiplied on linear scale or added on on log scale); otherwise, they are overwritten.} } \value{ 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. } \description{ Set or extract weighted matrix row weights } statnet.common/man/all_identical.Rd0000644000176200001440000000104513701734650017057 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.utilities.R \name{all_identical} \alias{all_identical} \title{Test if all items in a vector or a list are identical.} \usage{ all_identical(x) } \arguments{ \item{x}{a vector or a list} } \value{ \code{TRUE} if all elements of \code{x} are identical to each other. } \description{ Test if all items in a vector or a list are identical. } \examples{ stopifnot(!all_identical(1:3)) stopifnot(all_identical(list("a", "a", "a"))) } \seealso{ \code{\link{identical}} } statnet.common/man/trim_env.Rd0000644000176200001440000000242013701734650016114 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/formula.utilities.R \name{trim_env} \alias{trim_env} \alias{trim_env.environment} \alias{trim_env.default} \title{Make a copy of an environment with just the selected objects.} \usage{ trim_env(object, keep = NULL, ...) \method{trim_env}{environment}(object, keep = NULL, ...) \method{trim_env}{default}(object, keep = NULL, ...) } \arguments{ \item{object}{An \code{\link{environment}} or an object with \code{\link[=environment]{environment()}} and \verb{environment()<-} methods.} \item{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.} \item{...}{Additional arguments, passed on to lower-level methods.} } \value{ An object of the same type as \code{object}, with updated environment. } \description{ Make a copy of an environment with just the selected objects. } \section{Methods (by class)}{ \itemize{ \item \code{environment}: A method for environment objects. \item \code{default}: Default method, for objects such as \code{\link{formula}} and \code{\link{function}} that have \code{\link[=environment]{environment()}} and \verb{environment()<-} methods. }} statnet.common/man/formula.utilities.Rd0000644000176200001440000001427614042235671017762 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/formula.utilities.R \name{formula.utilities} \alias{formula.utilities} \alias{append_rhs.formula} \alias{append.rhs.formula} \alias{filter_rhs.formula} \alias{nonsimp_update.formula} \alias{nonsimp.update.formula} \alias{term.list.formula} \alias{list_summands.call} \alias{list_rhs.formula} \alias{eval_lhs.formula} \title{Functions for Querying, Validating and Extracting from Formulas A suite of utilities for handling model formulas of the style used in Statnet packages.} \usage{ append_rhs.formula( object = NULL, newterms, keep.onesided = FALSE, env = 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) } \arguments{ \item{object}{formula object to be updated or evaluated} \item{newterms}{list of terms (names) to append to the formula, or a formula whose RHS terms will be used; either may have a "sign" attribute vector of the same length as the list, giving the sign of each term (\code{+1} or \code{-1}).} \item{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} \item{env}{an environment for the new formula, if \code{object} is \code{NULL}} \item{f}{a function whose first argument is the term and whose additional arguments are forwarded from \code{...} that returns either \code{TRUE} or \code{FALSE}, for whether that term should be kept.} \item{\dots}{Additional arguments. Currently unused.} \item{new}{new formula to be used in updating} \item{from.new}{logical or character vector of variable names. controls how environment of formula gets updated.} \item{rhs, sign}{Arguments to the deprecated \code{term.list.formula}.} } \value{ \code{append_rhs.formula} each return an updated formula object; if \code{object} is \code{NULL} (the default), a one-sided formula containing only the terms in \code{newterms} will be returned. \code{nonsimp_update.formula} each return an updated formula object \code{list_summands.call} returns a list of unevaluated calls, with an additional numerical vector attribute \code{"sign"} with of the same length, giving the corresponding term's sign as \code{+1} or \code{-1}. \code{list_rhs.formula} returns a list of formula terms, with an additional numerical vector attribute \code{"sign"} with of the same length, giving the corresponding term's sign as \code{+1} or \code{-1}. \code{eval_lhs.formula} an object of whatever type the LHS evaluates to. } \description{ Functions for Querying, Validating and Extracting from Formulas A suite of utilities for handling model formulas of the style used in Statnet packages. } \section{Functions}{ \itemize{ \item \code{append_rhs.formula}: \code{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 \code{keep.onesided==FALSE} (the default). \item \code{append.rhs.formula}: \code{append.rhs.formula} has been renamed to \code{append_rhs.formula}. \item \code{filter_rhs.formula}: \code{filter_rhs.formula} filters through the terms in the RHS of a formula, returning a formula without the terms for which function \code{f(term, ...)} is \code{FALSE}. Terms inside another term (e.g., parentheses or an operator other than + or -) will be unaffected. \item \code{nonsimp_update.formula}: \code{nonsimp_update.formula} is a reimplementation of \code{\link{update.formula}} that does not simplify. Note that the resulting formula's environment is set as follows. If \code{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). \item \code{nonsimp.update.formula}: \code{nonsimp.update.formula} has been renamed to \code{nonsimp_update.formula}. \item \code{term.list.formula}: \code{term.list.formula} is an older version of \code{list_rhs.formula} that required the RHS call, rather than the formula itself. \item \code{list_summands.call}: \code{list_summands.call}, given an unevaluated call or expression containing the sum of one or more terms, returns a list of the terms being summed, handling \code{+} and \code{-} operators and parentheses, and keeping track of whether a term has a plus or a minus sign. \item \code{list_rhs.formula}: \code{list_rhs.formula} returns a list containing terms in a given formula, handling \code{+} and \code{-} operators and parentheses, and keeping track of whether a term has a plus or a minus sign. \item \code{eval_lhs.formula}: \code{eval_lhs.formula} extracts the LHS of a formula, evaluates it in the formula's environment, and returns the result. }} \examples{ ## 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))) \dontshow{ stopifnot(f1 == (y~x+z1+z2)) stopifnot(f2 == (y~z)) stopifnot(f3 == (y+x~-z)) stopifnot(f4 == (~y+z)) stopifnot(f5 == (y~x+z1-z2)) stopifnot(f6 == (~z)) stopifnot(f7 == (~-z)) } ## 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")) \dontshow{ stopifnot(f1 == ~-b+c) stopifnot(f2 == ~b-c) stopifnot(f3 == ~a+c) stopifnot(f4 == ~-a-c) stopifnot(f5 == ~a-b) stopifnot(f6 == ~-a+b) stopifnot(f7 == ~-a+b) } ## eval_lhs.formula (result <- eval_lhs.formula((2+2)~1)) stopifnot(identical(result,4)) } statnet.common/man/as.control.list.Rd0000644000176200001440000000352313776013155017334 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/control.utilities.R \name{as.control.list} \alias{as.control.list} \alias{as.control.list.control.list} \alias{as.control.list.list} \title{Convert to a control list.} \usage{ as.control.list(x, ...) \method{as.control.list}{control.list}(x, ...) \method{as.control.list}{list}(x, FUN = NULL, unflat = TRUE, ...) } \arguments{ \item{x}{An object, usually a \code{\link{list}}, to be converted to a control list.} \item{...}{Additional arguments to methods.} \item{FUN}{Either a \verb{control.*()} function or its name or suffix (to which \code{"control."} will be prepended); defaults to taking the nearest (in the call traceback) function that does not begin with \code{"as.control.list"}, and prepending \code{"control."} to it. (This is typically the function that called \code{as.control.list()} in the first place.)} \item{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.} } \value{ a \code{control.list} object. } \description{ Convert to a control list. } \section{Methods (by class)}{ \itemize{ \item \code{control.list}: Idempotent method for control lists. \item \code{list}: The method for plain lists, which runs them through \code{FUN}. }} \examples{ 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)) } statnet.common/man/print.control.list.Rd0000644000176200001440000000126513701734650020064 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/control.utilities.R \name{print.control.list} \alias{print.control.list} \title{Pretty print the control list} \usage{ \method{print}{control.list}(x, ..., indent = "") } \arguments{ \item{x}{A list generated by a \code{control.*} function.} \item{\dots}{Additional argument to print methods for individual settings.} \item{indent}{an argument for recursive calls, to facilitate indentation of nested lists.} } \description{ This function prints the control list, including what it can control and the elements. } \seealso{ \code{\link{check.control.class}}, \code{\link{set.control.class}} } \keyword{utilities} statnet.common/man/control.list.accessor.Rd0000644000176200001440000000172013701734650020526 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/control.utilities.R \name{control.list.accessor} \alias{control.list.accessor} \alias{$.control.list} \title{Named element accessor for ergm control lists} \usage{ \method{$}{control.list}(object, name) } \arguments{ \item{object}{list-coearceable object with elements to be searched} \item{name}{literal character name of list element to search for and return} } \value{ Returns the named list element exactly matching \code{name}, or \code{NULL} if no matching elements found } \description{ Utility method that overrides the standard `$' list accessor to disable partial matching for ergm \code{control.list} objects } \details{ Executes \code{\link[base]{getElement}} instead of \code{\link[base]{$}} so that element names must match exactly to be returned and partially matching names will not return the wrong object. } \seealso{ see \code{\link{getElement}} } \author{ Pavel N. Krivitsky } statnet.common/DESCRIPTION0000644000176200001440000000233614056677262014754 0ustar liggesusersPackage: statnet.common Version: 4.5.0 Date: 2021-06-05 Title: Common R Scripts and Utilities Used by the Statnet Project Software Authors@R: c( person("Pavel N.", "Krivitsky", role=c("aut","cre"), email="pavel@statnet.org", comment=c(ORCID="0000-0002-9101-3362", affiliation="University of New South Wales")), person("Skye", "Bender-deMoll", role=c("ctb"), email="skyebend@uw.edu"), person("Chad", "Klumb", role=c("ctb"), email="cklumb@gmail.com", comment=c(affiliation="University of Washington"))) Description: Non-statistical utilities used by the software developed by the Statnet Project. They may also be of use to others. Depends: R (>= 3.5) Imports: utils, methods, coda, parallel, tools BugReports: https://github.com/statnet/statnet.common/issues License: GPL-3 + file LICENSE URL: https://statnet.org RoxygenNote: 7.1.1 Encoding: UTF-8 Suggests: covr NeedsCompilation: yes Packaged: 2021-06-05 08:57:46 UTC; pavel Author: Pavel N. Krivitsky [aut, cre] (, University of New South Wales), Skye Bender-deMoll [ctb], Chad Klumb [ctb] (University of Washington) Maintainer: Pavel N. Krivitsky Repository: CRAN Date/Publication: 2021-06-05 13:40:02 UTC statnet.common/build/0000755000176200001440000000000014056636212014327 5ustar liggesusersstatnet.common/build/statnet.common.pdf0000644000176200001440000067415014056636212020010 0ustar liggesusers%PDF-1.5 % 204 0 obj << /Length 1110 /Filter /FlateDecode >> stream xY[o6~ϯ,y%6-RA8{LhG$".~H9J>U6y.9 'd>d 0+0{4f ̽OKYݥkR dD򣖔xRl$1 $~@bl}N}eG 12w6% pd( dLCgO'{I P7PҶkwC:p00 TYE=<-;mo[- ;\eMQ.:kU*Zr;[+Yl?> stream xڵWMoFW19~qI@rKCQ$H*}߬(JHj@{;_vdHkJ(QH Hg4 A’-t$I)I:<>!e18,AH))Mʒ1TJJ҂XZR"2$ ixud%2Vi2EJ)p.MMHJVX9r sLMXsN1 G"1A*1 ؑ {B)6h$vh!\ĈB416jy''Fxc`8x'-׀%`N؆ıxb\!!R"eRSv C>c"\bN2@id8t@1Z#E0wPIJvp(HD'' O%HjN& 5HŁd#f9i'rPL8dOmjIm>s**蚢5EЫŪ &\6a,̳M(^ӛ7+(FfGixuշ&ܔ]?g}ߎ̧uMuЄj6m GwGA—Y6sL'&s'iغ=M(im<{4nYݦ1M_՘Aš 9jua1g3e֭]_nʾ,NM~sl]3j5٠gi|m~z!'is[2lߺdQ>ۢލf1&;ObΪ8dkD?Oc75Z vU[`Uǃfv_pv;Omui[v-1僂}ic|뀺:v2g/;,gle1~Gbڮ:5<؎?i 'm;L3tE??Sm)Ww/tT\Žfَ1WZVc 3`8o}f#(Y_q"։Yu84cc ]Q4>ڜ? ۬onO,˞?`Mu.h_N~/>p:SLG\[(o}ǡsZa\ cZPk߰E}~h @=^:5[Ѣ]Ų%7ɛ-8"vUU?|Nݏ0aLGF9j>7 |ns{Qޯ z뿂>&=as GH1!Zơ$T8Sk%B8]>շo]:sqϫu7Qt[W>7FeSv_K$.: _N0wp[y40vPA'!O'|}H.wH}0:ThчDR>A9`ZN_r.pAtAPfއ|IK Ꙗ" endstream endobj 257 0 obj << /Length 1012 /Filter /FlateDecode >> stream xKs68x86;L:j/NFá J@ >dKjCKq!(W,&煉&R  c `:w O?]ps"DnSҢsUD-PTrqu)۷zucG"qӢ:+i_ZIQЦaa$9ƟjuI gTttvy?W NRdZ=ϊTk1-9y߱!*c~̴֥د\#Ui٭I.6wnݍiۦ?HĞ667/G#Wf|HɖZ"ꖻR, Դj_7en ZT2x0m4ۏg'??V_AAVN#0}Quf }2j u/GޔVxcÀ2z6.&P&x,PJ8 FzܭamH@l7zȣ Ɂ xBJgmerb'{UDH-i.{ANl؟}z~}}+z{ qF!FrUڋCyev k t ?Q endstream endobj 295 0 obj << /Length 1290 /Filter /FlateDecode >> stream xWKs6WΡTB"HӃڝx2X%thPJR QK·4x hM` DHČ%`¬%ꚺ$evOt瘤ĊPs@ uZ`owo&=4aVnwEvLKHʝ#VqN$SQr:%RuյvT/OJI̓^󈎘x;kV XdNSW;bu+L($N!br;_m=% $AC}4v./2ݍD[#@&D줔=Y[.bCm1]' K]_$sQP&D)!Mpšm MԡQ3mB = 0$2JQߡ`/`aâ31XCҿM U힍S~h!Q&laP8<Ԗp!*̺N7lWm+lXg3u]dZ!Ư1xL8l )uS4)NS۔5r(4GK{a P:NoZ[5h!J{Yl_-ql*&y)N>d(, endstream endobj 311 0 obj << /Length 971 /Filter /FlateDecode >> stream xWK6WFl/I":lݢR$ZlA^R$eI+{`739c_f׳LEHB~!HY"aHX-{=A*8d!fZYץ!gZ=_HoRIջ"+7;O#C;<|!$AO`އ}V@( bE1ñU^[#;,J5lz*0GklbAN]{,A].KvvZ6KYS?+f0 !>} 'BdEK5Cݳ<HAL㭗ܱю?7:+rCMtƞ/15N{R0}\ 4~3DVG.7m^}$@wݕ0b;'>gmEL]OqV ud.K.e'654$b~2 *2yUuegG] T:4^#w_XO̳|T+?V7>fMw8y6FSj5LŴOz kSA$H_HG j Z`TGT=k-kGB%2V (fbVߺP.p0ǣ*Gd#+usZ u$U׾vT 2UUVPBt %.OtAPf=YUIm,7ƇH.ړAҡhz4Pɭz{՜p+<0ٱEnχ;O]oK㷽+}E-QO_jko]|Ávʗ}ivX6SVOuQ AWЏޚKӾ};/єmZI"ֻ̇4b&Wߐ< so5w괼8H%HF endstream endobj 322 0 obj << /Length 1592 /Filter /FlateDecode >> stream xڵWK6W{+RA{hM6h9m@Z,P$[P3Ùo>|_gV*"V[> dE0Hƻ;~ciY4U4uxX~A&Y l)2&.Kd@GzpR{!P^ Ci %R%yV7_}ßx>Kn ןB͍=,^ڼ}{.㦯@ݔl[֦f1ϱ{ADuQg6է/wjόP],Hm` 'uIH$d!A J b\W!֋2Kbb"f7;`/"vܶ MX eN+eɡ(G@.hu햎tp)w&@'y4!? Ad̙ls*;tn6CGz,v.^H}T̵[-MVXe)YW1,)Gu酀dpF$'ԧV*!\` >I:`*Х vLr[ T^߬pp<P]V<8W'P]^{:D9̍ 5NIU&RNC #Z-A-NPs% ,S ۝vP3Ը zm*mx'&{fbG멚MU{ރ3v:.e?c9wPVHBrPdAXpK᪹74ADbBV-/4?n:[%C yn[1sI`Xv }yXU^tF q|qJc*'w{ vdή n97qw%V du@Wiq.]](586a*镲 I4g5oQ<IsXV`M@C5i_+LESOEtXrm_hsN7CS㬰dc5}Y/ʈI n+(ݜJ UϮҢȪw.zG%˟*kSW\ endstream endobj 334 0 obj << /Length 1248 /Filter /FlateDecode >> stream xڥWKs6WHX@yt$iKP$$H+w,iR]9kohph]\)( QJxc$Ea}.I'yB e \T鬄n%E[E=$nM"W.lz1\13aF]o"겑V]kTI#(w/}VFvI^:F_ z-jpo>X,0^o Hp҇pI''J9R|Eq\Gmi o2#l46L-c08QXQ}Yr1Q |Z ty[G]b uM9ڛn`^e?˱-hY#{9v`} W&j Ibł(+~\l}e<ΆرS`W]Sz2gyⳣ)cZY%> stream xZMoϯ1pX_vn0l>(l DiMlM#S."98@M #YZ`\P!mN(ƩnfT>7 r,{%9M%|JC90ظ'gҊ%ւRBJrk $xeAE,97a'&҂dfMAYf{R JUI**ԂqjJB^ZV-P6&LYn`0a%.k :3 7oUFatӊ3>5G 9ya\&efΞ!+: 66dF0B3^ wa6_?}>&?~X#Q@; (Nch=1P_hBiQ@?\-4 <`0Ri Ml3$9fPT@d=$eSS:26gg0VPO6ˌEr-cW&OO;?UH5vbwmn::WKC$T |sy}{r}$q"8LH,cg> stream xWKo8Wi%%>m(MlP(m %W&lʲC|pf>0I$yG0F! Pzww'vWZO5J&F*ުݧ7T蠘#8/3nmF@N゠G^?`/<$#uQ0Hܻ3ƥD0xȥ#w]pHF[VZ<>h/ZV՜0_3q _MEɀZ3TuRe&+ Ž.f & ($xGߪ :1D:`4-jڪȊٷVY':7qbi6>/kYÊv2cma]εNōJlJ?T[_SնmbYy&n$.3M/C[O*[gE 8q p#M!fMWSq`mm 8XPxpPxː"B:㵚d+|0oC;nU)S+t@q][8vEL_&L؎QFMӵ$EșK^'\ajLIO DpDӳXp#pL)MC6]CMݪϲ6= 'IXOY6J)+\=h"0H[wT fjaN9[U I^a5/iXu0bm@&o쌎TGZ0wfZn{I/> stream xڝVn6}W+CR.@Ivh'/EȴV\$Ee;^Ĺ93$~8\ܤeP2Y0cY KXD_\ܰl`Pj쑪kJ#^UBN P% bf\?պj$xq,AL 9]`aq5GsW|| ʚCuFrs) 6ɹ%3D @wxG4M?!]c5Vk )'e1cJwzv 4f=\O'N p@0ieP&_`(J"xGWA Mp7ZvB f) XXz:X>BQY tE1e8XVŠʮD(ʭ(ea׸ :MWŁ"MKIJk]w-tS-%N^M_8p%9 kE?!e=*4og\z>mrF4$8l;R׼p]-v>DmH)L"lsT}#(2htKn*=n/@Sძ߻č}lʻS`ns~:V<ώiIb : y+ Ss[[mvy#2aU'#)]ΟjVf|2XBc$;5w.S-l ֠tD æ]GQqm+6z\v̤D{Bk,Y2uK@v ZΎ,Ms|ِ0Sn(i;?l@zt7/^՗[˗4oQ}jTT6֞Gg/-pO]e94F|knjǑ#G77RfCjg#`JY cN_>PG)JsyT{Ҽ۸Osrѿ@dw4;5ޙ <ؿ<_>#7*kNt^5P5qǦ8!+$IvGxAO endstream endobj 386 0 obj << /Length 859 /Filter /FlateDecode >> stream xڭVn0}WX}J%jl'vb=1@ /Czm MJ﹎,R&TUqs= A+DЛk.R0淈HR,BK5XWjn'od硈 )piCFq9QD"&-6 Z[K2A:t"@G!st=;5[%XD NqH#5 42M1~j_eFMf6&F#h7_k7BjMVnaEi6 1JLjd࠹8ARzQe[zN4o o[QN. qLi3-.q&de!tR^m,wqTVf`GIdz öSwi9~ZQ*~rQN2YrwLD @INBESʛ&$DS'Xz*et`:սxr C>+)# s!4P<:]A>VnV\>'~΍RCS2Bhsvj;Xe@V@8H@ %X H̡{:8{JZ2=gG;֧]Rms4K{29]}HN=ŴgŠ`!j 3њQjޙuYٶMs]OsUT'x{drvVf.40pj*+ >[ITwf+}%LD- PG> stream xڽW[o6~ =@͈7I k(-^bP$&&K.nw(e^tE;|“Q~Znp$rHb##&2G?-ݾI&CS 8\ṞY_/gLCD(0 mg?(wd>G3~ۀw:3q< q aWlvEWkuU6#xtboҽji O{&s 3!kByebeU=gqr=_PmeeUi_iW6UܭSiŝT-CgQ2DIZjZ82-zˍn@zAvAٱkԪ+ ֒s@P],$KmF^ٱZ{U:W({V*O 0&RHФk59Wsu&1>Kkκ۪mjs] y#BP=jOJL9?,-xL)!`.T+KH~Dq"ccnrKOR]7R@p.up8#q0p ֓&K|&CO ;8DQ4H$e%BKxή<ժƈNpfym7 %qcJ7FվR wTl $4X@tcyzH11p,JjĂBb8F<̃b1> stream xW[4~ϯU-[faa@]tlg; on[>:|Rv3:1C/t+` t"BPbv|[4iDYwD#x={xY6e2貁(Ͻd,$΁7 CFz+Ӂ#օuo + nQ:sn&8k! >O[FZ~DR?7ebO;15KB+xLVU )݃bySXCT}.K{bjIZ./1JCPk:96#m)-t*jXsTWIx``0 :\ɿOhT_^T.N q`:%f[@}E9_ PR$WzJ (oٖjic?-jڍ|͸Can-\%yl6nUFpط! {\<6Io'_p!c0gh}jN驒N6}(vXX [iKǮuMAi& 2?Np i endstream endobj 427 0 obj << /Length 1137 /Filter /FlateDecode >> stream xWMo6WCm`͐")QX䐢Ib@S6DB%8-Ɏ)`CpO~]L.oY$((X,1, bBPD`wS^򨷒$;횼XB>]VKTm<?bvR1LRgFo*m&IW7ؘV1ǧg/IZ]ٜc?[X9@>Ž)[MٸÌL8-aωǴڔR!M)6 eɂBBp8*T$'lg5d}*=~2iC]|^Q >#4w 1"xx .-TrɳW*W+um%ͺ] )v2yc1%XRc&qtdihhCrOr|HK5KK`6[hz(ZYEX\ƯDu9ꉟ< .E7PMS(ӇbpRzp {{\P$N?o]#.1\X'/=ri1MeWtAK|I#د<0Ҫ'!>Eǥ4N(@"ᶜH: 5dX[D`ьA)qH.N|)|>nfd*"n-ڍR7WmԯW~tuz[ݻt5 [i;=!Q_Om ѣb?vϊ~(=TҵJj]FRKT.U endstream endobj 442 0 obj << /Length 965 /Filter /FlateDecode >> stream xڝVr8W*@UF@V.NNUnNdFc0@;e=-$`Y'$$nAWo7W\ %LR,b6[%0}!#}mS#'F(N$ v4&+[9]{uZ\ ULͭ 1U k@vYۘ|)*?c%Dp >,8,eS@ݯXz{;GD,yK%p %%.K|i$CKաf^l:+,%ǐLa@ 9c$09$z*FxFkJ?z Ak8֖ tFU cEWwEfe, =)f|* _DhŠL zUYT; D $lX7Rnmr.A]9Xf_}F~~@KI3#50[ 9{$eH∳h3'S:5}y*T |]{!Cƃɨ/l_&|/4; sAh>- vLMjcki:l>6:Kڡl@9FD5sN4<áܻ:ٶL4Ɗ~֍Y`/j[%7w~?7X(=H&B/Ɗz19 7g3{>y 8~透KU_K"x`oErvxDOUZ8Ao^Y h9e~{˕[ݹ׈ux>ZNEbM'mA]Z"ڸU:a{pu G endstream endobj 346 0 obj << /Type /ObjStm /N 100 /First 877 /Length 1621 /Filter /FlateDecode >> stream xڽ]o[7 +t l6`h{-EE\gm8DQK4(躽%f9x4Yy6Wừ"\+DXEPjA6R]Lb# sfZX7(F *ZVRP킭S:dԫK_ IEgRԌrKlM*kY2],vD5~*ffr+a>. N̿`n :)j'S3:fh{F(6"vI} p7b 6e{aID K LUllG!"6d3KKg fxM*E9pBQМ<틀q'iuNzwI&iBĩ9ĂLTR'mFܲ<a=M0 ^'Վ]%!eY&u8BAc8Kήd,E1]k\Ė/}-knhlgV ǟGY廋c`q? $OG=xGB };툀'h^ b &| U [N/6{z/7V/\lm[\|t6xz>]P8;?yzm n՞^ɚrbLs{:{~4o6j}XO[?ϟŔ<ݘu/-aώM}?^ݳWKv9'oߛJ '|׉C|KrnfZ q>KoƁA=򍴈l+x%c>n*w " }wuW*\!.`7s WP⻸jL=m\)=]'3LL*qQaܓʖx>uEx$>Năkc KS|ۖ9OϾpvkKᳺܜoِia,('Vont|9ۗ$)ԷN;d+WٕϾڨT&bzWR ^4\ꙂX4ȣ`sꠑ}f9$Iϩ̾ݏJKD}RYTӊfBغD]#Nn..׋ӓl<*eysb JF22Ted>5ƻ*[W8Jl`ԶE[j>S 8DJ4azo%NrةuLHջwZRّw6y7+e,j* rSB8x\:hl_\9-R>:mt#2$ El4 endstream endobj 460 0 obj << /Length 1318 /Filter /FlateDecode >> stream xڽWK6W IuurIsmz–\Q-v  FԐOޏ~^E HhEqpBP` $x%͈ ctf?jvf#"H{vSD,w/_q$٨X G?M@0Jb$ AEsGA0"̃O#Az#'ƴ.d8S[gJɕWgl܇r+n!+!JTs4Jo&%!SYUe -(mWm- kljAxqz#(:4{1Ű)bY6E-x>qBp"s0r"0XO) mMe,zD֧I HQuS,!~5/> 2mq>rH_w[1q'\V7*cke@<( T$5m[tPaZDăP(h ~|jFp:_GUȩt6J ʭ'=A®\viF#L+p@o1ߚqɇ˶%$i}%^ץ}.{K57dt*"oU3\ʔAR~ (k-] 6\-鎡cgpag LcPz;X{g97La `q?se-BKZJ)FmJrLYM eZw?*6UmC}b 뎥(Hf:5?i&v؋$|M|\'de:r^nHң鿑7Ђu}D KSin`CВ r,WO XYL 7(I7|KTOgf25+(w_7ȇPVcqA@y]B2fG^< w ˲R9?M=wy/7DRBy&yz'C'0@S$g\%U5%6!yٸO,f=Jwۭ*LkH97͎\-/L>:^#% (Tmu?p95:NQS]>HK 8s&~'ޗBX UP5ś!g1?Goa24D!.D؋wxkE{-lrenjyĖŦ{&xjn;g]b-u7~ Qj6 endstream endobj 477 0 obj << /Length 944 /Filter /FlateDecode >> stream xڭVIoFW Im>H撤D)!)}!)L/IØo ,~]-.B NShF̅BX21D]R %.WW"9(V^dAWW [EEst >^#"Dþ@-MNW c(`%(R2¤Z0i pՒTVwːIh!wKZLe.Jls wq`x&m panڴ޿KQH,sꫛqUYpn,V6M+54n߿k3H$C^*ŠQ 6;3ft@o⾶in.RъI;c"/mX8sPH9v$_!<j%лs`qW C(c.͒ƀp 1;w]#5jg&p9a;ѐTe]-M"(ƒ֌.T c1(ۭ.'#qx`q'I2dC=%8'. qD74߭ޘN>v:L`l='T'_BIH[7Dqc?mgN`9t o|P)'tVf*5;S9{{y6+1v3xl\1e7|!L1lg !P` I֘3CPH>^^D2˄gM;;&BURB9[ >b0T AMIU8 !/!==l$/Px}0c_8*/T0_h]}~?CC#δ*?{jt/gضEZmkg}X}.@C>OoU5U0~" ^ïc endstream endobj 490 0 obj << /Length 1555 /Filter /FlateDecode >> stream xڭXK6 X3DRZt&v$4LȒ+RqA{JZi |̓ ;/^\x^JR oh oI)qGՓ\ vƂeLgS7WAb'Vs =K%!OW,w[w%,q齽of|h `gÖIް/YfZ~V9( BDޙDuҗJuw uR5Ҡ:bWhVTw qAw ,!dM2Q𡙿H7^pa3/4j[(0ڴU$*u$^suÛS,~5YY]ލyH O+UttPtt ;+NP_V\q3C`oEEsa30dr_6+}[瀆LrʐlMHDˤ@Im赱D b`{ׅStu4L;U"Z [5KrjSٝ%Cwe 6ufs<$+4]k+u  ?tyȚ zyi4UQJ_ʪ.W%y5qƦS BCj 3(NB~j)-$vpbruҨ &G,e$IU[]JuVc%$N85rll%~,5Z\-j!r˼ܻ-fD1պ8Ծ4 su-ΙD  (QvDIf P=H.rLdG95Jn|7E ,gԠ)kO#uT]'p9LPaq}JFR4o`@PW'¢0ڧbui})!{9'S)s)x HͅǛZ?٩N$)!2J0F\6(4Ɨ= eI] 3 2P,vh_i)5me|f 40Av -MN7E] #_0{icVy6Y(C| -r!7=]mfHPv[9W9^ IIy[f͛}:K\h Uuߜ>l;^_#-O.f6ނgτͻK#$=D!@C;2'\3Ɛ|?A=he7 endstream endobj 502 0 obj << /Length 1186 /Filter /FlateDecode >> stream xڵVKo6W{1[(zHѸ"X`o/EشFWwCYx^$> u"e;ˍ#8gA;,2gv)E*T-?~X jNEfY rGTI rV7a[Yh`E0.oPgšp(f" .H>RhqV+̓G(lUw`) ?=!jc՚6|on/ܺ`flt-S,$}P"zofQeIªA1v'iAυUqrM#U]lL+cn1oOO CyNnƌdǯRG\XpAqr':үhp\4 6( AG@ń _k< zqfysóQA<h3gw< 0o-#??cIbIǿ$b#"^Vf_'/f{x`jT.n1Ӕ l`*/67R"E=\ jGvZ,\wq:[CpR[,{"wR6g6XN7 ^BVvgt/6a?ڶ߭2\^L.7> stream xZK۸WRy &eQ*88GЈ1E*|xn4dO9fu׭Vh}W9˕PGZ3kmyWo5˔e\gߴǡ*ЗUٗG^DEMLdlc![blEL3Zl"I˦á4 ?Dh7|4/`Jѵ?Gzz7(nW⛊\`4~#I i+޷͑,XE,'2hOxNKEO"[mDUBr^!b͒>-o~z (un췃@3x8h%Lɇc@3n,U2fwhOͫO='Ж',aQڃW2Cw+WzjUzuGMh(TFemWN/G[!fܗwv*Yb|P]Tlxw}co7{.SN]1|o;ƙhlںD*QD玆`O9ݐyՆhӧVߡ^2.r2XUv=sP9wL2P6D+7οor.A_xE6N}3]P,/mqa;)Znӿ_le~f`H| 4,Lro[1?v9J7}Ȝ-*{=uQ4)2 azە;AD@7)=̛څ*&He9K18*)RlPVUԬ3}HĜepD n<>^ EY6~ׁK/XkzvV>)gNGPW-#8R)6fmɑR11 W6;:W%?v(opR8k)n)}[~89z"cqw[CxX<`F 1@NM&+&A}KE2xKL&"i$%7|7 3np. -ΡZpЂ\ǸN E8Y'X 2fV tCȁ<"bL>V#ڪ_`6qb_Ozf׷9"2U h[-`Q>Lb!K-cRy@&Tǽ . (Hq<|$bXf6A.eac?wx6[)y"=#Uěŀ;9nƴB#((\D%,K'3w(:tHVR;_\ >&'ܘ\<Üt\%jDU$!(Dp3r.=auwp3{t!R{3 .)zc/\_ؾ =JÖq͵ז|o{zς OFb)cy_VR#ַrCVHhYC# u\Ƨ~f҆Sݜ\jڰvhN-z:yp[^Onu(UDC]1U!Λ Ϗ@WOx#]CI?^0{7 `jRitƵe>7OY0)KfFה"68rU"?7 [$8J9Kg}*Tڛ *ru1s7mi3,ӞeO%Q m{a ؒG,ɲ/em=qid8xCMZ66 ȩ)b_inI,'&0`{"Lc, هLj$0P_<:3{l0#1dpFm%%}|,Q"34)0j~U]g/.4K1(ﺾDx'YC/ndԕ\9-/!.[H+NWK"osPe218u7|32}HAʢw5'l'}GYC@?Ҁb.t=6]q'drq7 P; #h@*CA"`cWf8zϒ7[n٥LƳy(LՑq뼙ݢ:ilVA<19s9˱Il;4sB#Y՛P$X6αEJHXTw\L'"z9DznBt\%~8M/c+id !s,(-aiĢ$`I([,Jn[Xɐ]Ҡ+ڦSFl CPV \WS{5?Mp;^^O8m1FP'g2TLO7 5Fi>-p_߾/ҙob endstream endobj 527 0 obj << /Length 1195 /Filter /FlateDecode >> stream xMoF_f/vfЪɮUnSmǀmT .];mbK9y_6Vm|<{QH 5K6r\j#<6kY""㳧7n!smxJ| n4E|sݎmY{Cߛ{3 xa@z~fy=em_5Gˢ܁E0 Jbi{+!JٙY+3rIx{_#(Žp2Fbqbw&:Rx]U~k.weyc#grﷇO5LhA)L^,ӬJssQRʠ2kqs^z$lZ_ W.m =DBX 4bW=W@Q`+tF]/#)4FY ! r1: bt 7ht d4:(##elKSt㺬J\XKeY{~=>''O@xw{jS#nrIeٗTV&Ϊikyn]*2/EI^`Av'w? LlC(„fd1䄁Un fguΌ?&r|L,bñCD s$=z7QR,`;,X9si|f!rh[ZA+,Ei ,-,0\IB#zo4 !旄Ge{N..:`FFb0d>։8 >+Ki!*),|u]pM.5uQgzo8O^2t(*u8۬rX.pm+:X)F7(O'BL|61=2 DE\GI>:mHIĦؒNK}:ntQ+uqe4:NP*v'2X%u}KT1 6_R l莞SY+ ۜeQ:F2C#mذ*Z#V>T){ i@=q|9pIVpiBf/ H߭ՇnWLS)k %50imTm" -d,2ĢiBHFO)K 0ýiv"~iu6!65TT#CErFĦŰ endstream endobj 542 0 obj << /Length 1921 /Filter /FlateDecode >> stream xڕXK4ϯ j#d=(,vKQI\x8;˿[-5Lr,6~ V"Q9*$a,2 tRei 5M3}kqd6l݊ &%C՛96N G$giN;f+4Cu4ϛDOsU0wь'=ݿچ#{\ܙ\ ʄNծĹEmR%) -NOB[͹T&бi.N&xhhl&j{ǟˮ:TMs&EEs+V(ּãu\{ N`'nJNc̽gZ/*_նkQj dAC) &)V=zK7gsosR 5Ɋ,AJ)$A |BGsiX+Y^:'j6Y8Kɳv;G]Go-W4|)[ڴysc4W av=Cv\J d>ءRǏuCD87$aYgۮU U4U%VL)) S\ep. [Av@: M|9Kg/f#"11@gdLotـ~}EQ+·ba_Enyٙ;I )*k_v+@yT6;w~kEIupգY, _u:\BgY :V%BASف3|WcO?x9[>v믟>%nog}C>R7\3>c"6y@cwiB My]DAa.  ໒+U@(|_vP CtE>2?vz)|</zp G{:Uv/ >zH5VĤ V7i,Y@AiA&sIO%y rOzX\3cw%#b q DّƯфSa55Zu0u{COBG+(N  d wa'js+_d2|^P|}qFOA(7Pd@C 켩wU`\z~OY\V{#ơǬ: DǾ tȅhvVOSK> stream xYMo7 ϯ1h%R-Abm$Y5 };n*;il$QHi .%?+q<^#_Q8ZXKwI[Jx]m.N1VJ1|r16A[" ?)HRh0X̦f&4 IU5 +dWI0^FA'(L!PQMX#&G %P k)lI^$F ]*D1LQàWUL^ ЫdDŽSPqAu0}FٔMĩbB&A&A!xR0-1`XX(8c`+!6D+Lb ,kBbd33h#k6`3!&)a*)9JB^)C;1 b'N6;+BCSh°6,FH667`9rζ5r ..KsqYM] &b? ajngcEm` fM`# pȞ h =欞@BmaQ3 xw1_7\u /&_T`1={x~]7?ܗ>a&O0m?_ E8]' 7GoJ1t|P.F}g>0N7yyjx6M/oBx=q~^LCF Bo9A,G! &~&?,;t۹_-?71YBJA0o4(BQ_~}6H~`޲)'6#c+҆MFEfN qUĵQxD-z *,F&K*hϯ0e=Qg/$s.86ddTBm Ɓ͏LFu_+ׯ]I^ɫܕArkđs=H)K M;x͛)by4]Ċ6XT"Ymu1OpC !-Pqdv(k|# XYH;R`*S`(qj21\DzÏa{zT}3Bqzŭ*h3Qlv4[vDAN_+[d]n,}s[mKnA]W';K8c4 H'v-r>ﴺ09`QfEY[[bkQr\2H9:p#7$tzfꇢpz-ؽj3\^p>δ܆Mr~6a)nv[vF4駠"Ci 3\JbNLp8xw7OWtlnL]H[(uMrpW6֮v5k_k wW>}8{QȾH3 ++:'=hZ6&W7?̖72 ql.C/P[||_n \vV.j#Xl/Yo#  endstream endobj 555 0 obj << /Length 1486 /Filter /FlateDecode >> stream xڥWo6B@̊G}HѤؐeؚt e&W#)Y8~w':a~NBơG t"JI'f嶩D*IתMN%Q "5;2%xy"{ +z87:?QP2ocI\$*TDfu3͜z.^sI,5Z-NJߨǺ1< Z~#O-ê1ꈶyʵrZS>Ue F]ͣj*o=~Hx: b­6],F+Q8$5Lc( ȥjuo#<l g' C˻UUfoȲf ׽"hg- -ួsVc䢧^.0šVvf.E/~ZkYZ]]5THXUTt("  0L{ VV&+9y]J4(} ۞ ?p>%ABͥ sEɟC}͛FRˮ`LG iq"BZUy$sc$%!twN8 #}ShjZIU3 UaUsBM7c="0jcރwԡ,9 cT],Z.6|; :l =s& o?\xf`¤dVaظ4HoZf,k#NĢTO$)ʋ^I03!CcrݥCMRxh!O=h.s4b{)DH7aMp(00.s>8ߔ}D# tt5I]fFی깆N>5%u5g(Ι9g_Ly49H>7>lǬ&FhiY:b+jsڙ u%/8'1/ioL2` ^6iƮGn# ݦS^HճF8ϴ̫f~) y/vg5,=憆C%b)*>] ¼e,z5ۏgv$9}0{q yNУϝ9?me;X endstream endobj 573 0 obj << /Length 1570 /Filter /FlateDecode >> stream xڽXKo6WVEhi)uö dE%W;CR^v좇D$E㛙#.~~yus煋>QJ\_HƈŹ;vBdc4uU-"tړͨl?o\ѷ 9=> ޚil;\' +bf>Gmy_TPm>n>HvHazbsyVIp<2ʴh27۪A=tÖI*-.ʼ6y0K4H`H($95c@F$&MgEʒ#&_0B1>pQnwcGtZG#MBƺ$Nȵ4׺4GYdQ ;xTZ?g`#"`73!C.Q _BXV^Z!M3Uppڣ ?,{.D.NArb=uw9=P`Gȡ_\*0O] 5(*L~zaVTq@J+CSd`LNE &7}ծ֬mQêN ^H2mvnʸ(ʨȟH*mjyk0@f~_ó,y˳d;܉SQ(.#TjG9>WP}(cܔwq\!'{I67 p21,(- r*STH="<"4'wb,/ s0ɪBԭ+`.Ӄ* u5G:#AZN{ߧY/Z!F5 R\d6׫,;K pv0.J..+('.0KK!2TC4v-Quog| =UE26"Ĩ 4=Pd:,HxCg~1zs8=ً^z 6d3Sh*0P?+mŨ;^jnJOug%6&mμTv,v,zgd` pTxT -a>\jJ fCO2`FE; ~ Ѿ9p3Ks"wAUPqFڿA:{dh/V]AxpeyJQپUt3q{߷aIJ&4> stream xWMo8Wދ T,It!E6΢@ۃ"3Z}Uw(R%ˊY %pf "j c_0VwmG R,l" qױV^_9C(v=p,gZ2#f” .Ca:5fiul'zOo86!(¡HpCtgΰ87b,BKAYq?r<3VA$xnM2ơup3m lցY;Ye\O,AaPmGdzPJ>Ô8{9uS lA; YL`̫`#GT2;e*'d1ns,fc۷^]o=y57oH?p8-Y}w{QU84,6Tfu5 T]e=8:.0<07:)03^V ׁzv[b Ͽ3 v\4u;']> +;Pf/la$H# ]j뉧Qx"AqКLa>,ϧEvF,:38%>"H,)9¾#w}.e-N"%os,FmZC5H6:/p'a햺&'bbRv`7xF k_K5} 0j.yq̌EQELT㯄0uRJ}_语Ah=Yp L5 $={vIij (^LTQ`ҠTUBXGeDcyP#vp cY_h#ыʏSHh'Ũ=Uޫ3R?q?rfj=FGXO8).Hdup:]@ѾA( ę4 |u$>7qM}lme_Fݸpu1h>vZ F3>r5  endstream endobj 622 0 obj << /Length 1038 /Filter /FlateDecode >> stream xڵVo6_!/23HId>dkR`H ,q#ѶVYDiYEI:C`M;;g,g7L8 !#'$T8Y?,&y!iT>~5:3ZA9`FyACj^{Ԟ􃒙Fh44H o1 #SRžSƤu&=d,+99Qܨ<,V]ЋIeQχi %#O.Z ߳t cdžήgTClC|'V؉#0Ss$\ Թ'T6) ) |8OgNi (% #[޽9 >_w d~8wtc[UCM<}xb?모+t}F^m @c1C6WS:*JlBr{\8nr9~l \%YQWݖe^g, Bgqq #0^8oի쵑,T"J*m-vSfla $@H 0O rnkID~ٚEtAB,Lw19ubQ ~jkh֊noF2kq^sMS&~':t i ֮/tPj7`@ "G1h>Gyw*_[yF>*+ :NJ&_J 1p8MbE]*}~^ [@"dGIs?6g0{e.(Fmv<4B˝_ͩjכv*vkK+dV%~$/헼Uyg{]YXLhdKڧ`1xuȔk+$M|Te?D~B8Ac,WL(,1تZYd^߶&pf'  j1|L+>#d:1# BHcf9ݟHwN}N\ endstream endobj 647 0 obj << /Length 1777 /Filter /FlateDecode >> stream xXYoF~Ps'"-vHi>PJbIv~}g/^ZITl r5œOյ' JBNn1bQ݃RAi[Jl,k둡yE9[zVe*}fC8F(i}Xy %aP~V:P-xPe ϏF*n[6K#pNu/Hɥ4*ܫP-6'a kem/]ۿs=ƥ%?Syν@(Q{" л|)w#eki.P-CB<F *e%/SH󣙲=ld˜v qШ˪.j,͑yߙӱOFQ7*Ͱf5R#X MM&Aܢ6mY,vw Z˕;ܙSYJ(:xV> stream xڵVn0+"E ҢN"%Ah,ZK-ڒϐzf8ͅ ͯqqf{tn"q> stream xZ]o[7}ׯ"gC -@(hk몭QG2,msuNx%. ?hx8ϐ.B z"V{ E{Pa[yRS$h{ps5x([Rz mOU6s.;rJ8!gJUBTkk@0jCg!AOK8{rȞR9z19_ajy4 ,HKTPtTXWoa].~>?jg8t59oq{\d=Ѓl?WWoϿ>C0i%nO1˴Hu昔&|]Z_^..j0hd,EC_ƊZ炡{,Rbcݕq,%rMN& #F5#Gli-&SµGӄsmq~TG~Gj8rgU;wDŽqF*h0bD‡=F| [wdž@&[ʺAM)e,u,m,XXֱQ_Q_Q_};zlD`5 .v5ҿ9{s/;tԡՁF!Inʼ׻nj=<PE|6nG ,+-)yΙO1'xYL+ Bv>Na'x}|mzsOv׫G& k2M8Gzlb\6vYb̢LOBdcl|î *w8_G.qrz+]8~y6G/589 endstream endobj 666 0 obj << /Length 1585 /Filter /FlateDecode >> stream xڥXY6~_al_d`>!AZ)Z,: -;!eɫsHs~6懫W>&w$H6<7MnrwqӫQ>gC֫ bw_"w#Xژ<M$DEj[w(E"gķ#;B sCek2U'dҞlx؉f݁-),qCGds|:^"95X %K=3…qjJA`ocg9T؍) 13kVX斉,|F,x1Ճ^=h OU?s<@ 8H倎,zA#a !} JI-$wdOR)zړ׶s(2D'5Gy xģ0qMI.="+@ QͳA+Z{T%#1f䅒6qN6.aBkj& *}nY=vCS?^!ES7\ruqypN_uA6"1wʒUL ?& HBNu)iD%yM94!EʞFJo dMM&ܡ:|4\Ho6g-_R'YACfXbIA7ðYj.atdIbzQZSEٌ 4KC ZktM=A%PX8obLEQY.{`|ږ]rI@ S/',nF;Yt(5m]z fҧ>#W=6z_zſ!{yȳqx )7&^6OάNxKtzt 5_976 (o |ُ}XkFv<" 3"&}$t*@_wh@ %m '$ik/Gï }񹏢M@υ,)b>`/|pY&3>u|@S|>Qe^R,'Ӕ2ܪ~ۅ{SAjr%]&Z~,M<[5xsw+w!҆~Ċ9)"5`UǧW3, -mWF endstream endobj 679 0 obj << /Length 1239 /Filter /FlateDecode >> stream xڽWK6WE,.E= 4 -Z,&EI%+eK:ND!g֯͝O-hHBk\V(̬O6g_ቤȍ<8G;!RpoA#ㅑRqHV,(Qb\."aFx endstream endobj 693 0 obj << /Length 1327 /Filter /FlateDecode >> stream xXo6d fIJ=dhReR*ɋChˮˀa4=)-=}:cHpʽ# ^DWu&P (J[ڷɏ )HOGKדGeŃ{/ q0/=Q#aD/‘s"NBeNg4~2PK~/S|)EIχD ]4B4ޢg Ӱ%mux307ZI[ۓjx;5QoF#xLx`lg\ ykҌRo/)a~S 'H 4 %]:G _X?&6J.N`(>_F*GbS ~-M],)#ۣzQ'3ۻMe݁5gY7mcޮlE uR.jݨʐVk1{Ռ*Mb.$osKur Y!ȴ*3}$/C;2k#ʵ4d"d7fʰKߚd)G=CHw0B`eDA|0[hE'n~BӑH;s\$RhԵ s1s3$1 NE 9aq31tIp֌p\{?a#]H*+g`GsM57q5'sױe29X8E&oYV*ac]t]3_ZaJF Mgߩ*4J25>R1HJ8b Y5rSԂ)jn  V!xc}eJ=K)30jVg(Oyf%oW4|,88מwc1hFU/#­]ȟ;(EeUM$tR5B \zv AIkQXiItJ3pbZ^9xO*/d{cx@6.tTP?)6-Ab;JFyTD`L`7F^4IQN(tp\ _ 8#US)Z–Jx㙞벮^t0G? EGnlҕ &9@(=,ۇWWY]=q}^=&)Zj;B(lOu)/B37TԴn:Rɟ{!r^$_8fx yc{+'|f= endstream endobj 708 0 obj << /Length 964 /Filter /FlateDecode >> stream xVKo6W>ɀ͈(QZ H^b{qs`$V=vCR%UzHHS3sz_( t!N1 hRosIFpL!Z"'Zt:: Z/Tdiέ7w9˝Q[DoyiVb z;QFId*YP^"_ժHsei,)3d{?_߯Wng1;iu>!|5'LJDNc|X5wS*A`>v2r X8$(+*E-s6;p~v#3yИUT勌kUڽUQ*ٷV73U*~H.!{ĘQ(N=JoG(74\-# \DQ(Splnztа!Vg- rO5iLLhZ*.SI6^v >ڷ f͍ih5^4D~;. 1Htp|?a VhGaG\WoKq~v@fbvrcޤ}Brw;4_b6,53]l"  ?4}X?RctL P]1P+0Tӎ+qˇ,M y]zݞs:T3ڀ#{Cy#y[Ak`~] (-O~VN*C0 : 䣎h"kr1cWU95mSi~RDHIMrmoxJg.aZb6 6qEȟ~5emjꢩ~mVǴՂQ0Q8gT~!7 j. endstream endobj 725 0 obj << /Length 1394 /Filter /FlateDecode >> stream xXKo7W,rX4_jE7=$9$J^t+/);Ç+ml)@aKΐÙo>EUD7F7q$Ox-#F)2RH"n}oTKm'<ݯ72IHV^0Q午 dS Ƅߢ-ktShHQ/(a+jSHβż_;3ٚєyDf"4"2t]ߍF hvNDLͣz30 '%"Ϣ'+$D#hVy[:d$E `EqONⴧIpFM0Q@ 1%2 N x5s_wuׄ!&kʔJ\R<,RPtA 1coň=24Glwqi\[FoԼD)W 7Po3u0V{[Acܫ6طcME ?tR>z }w8a--_/(D;t5}xk ?^!舗~p±wN;UQՆ,bTCy N)ER <]M; Hj/9dQV7+վ>v֠R7Wo_w `FvwrГY_")|]Y"y@$!iZ8fCKؖ#"n?/`V? : PR*('W#d X+.dize,<һl,Y{rv7$tnPt?bZ%~PCC w#qs}x+yTW 4v8j(9~*f* Sܴ+H1Ǟpe ؼui¯^:CIkUV'8~ԮNcOGw^H:blj7)<Ta=պM9*RqOfM>tgkGkʰa(Հ\Tc2'2׆_I'cn3&&Pn<'Y5 u{Cylfk6!$\ڥzۇI;^J;)s/t?_SlI Y(.vBM~Ԗ>`YټaN{dVN0e4'IW|LJ7L ґį endstream endobj 739 0 obj << /Length 1084 /Filter /FlateDecode >> stream xڭVK6WΡRc1IanP4Y=$9m%^Wvv0Hy|pqk:)J#9˵`(8PDSgY8]J?^$e1 iz^uDSl;yg%0 .Ob8ZǟMGGN&p#L{a$1jǽB#M2+$xwu4!n6(}N\F'T poYNkCMBMA#dzN?!!:xd(%)|ni|+J<묃B*j/ ]1l} `$0W|yK^omVoޗ^9X% #Iaf8zsvy'4eOuc+Va!$coE $Uoek|/ UQZڮV^AW-׻ׅ2 $" 1 k_%:eKyԋu.]YoBjee[[PYi $XXy>R7A]Xn?*,gfݠ, c'NBsDwZU۳Uz c%AV#I`{_£˻ԧRvRJBAoc Ns@@?LDxrߕM#ZԹs;0mZyu(63pfͳzBCV'x^nw0n z@f-wۦrWYj"<Cas秉' uu!> stream xڵVKo6W{Kö- h% ZmbpI9Y%G:}04$Ùo?;_~ Gy%reIupjѢ[Ք(ǷX>0AiVJ s~\q@#AQqŏ,YhU) Aa cG8z#D:<#]D/N8Yb9_3Y6(niP0(z 6dM.9"9 ](oeS=="ɂ!KNqnua ] tpht@wݍp-6sC~([ޞUJ ˲9G+XWcd\\(A.4lj%F-4 W $ҀHO vv2Yz=%MQDpک= %6k h2kZLof{ln~a%{-JvF@唌[&C }bp-g ]R]bܳbZ&?t5=7`~ݗmy'qxgn73 ~( 6߾Ȋ(<:,31*t8/25y&(ra(=VZVO+WP'F2t M% '?@4r~`v#ݔ<:<$J݋އkq=$9I߽#;J<esPn-(MJ+|N$vĉRxI}AN198\ ayr 6p$ո AkmQL٘6 ڛ>%Yhgn>__ QǗ$ka[۫N;}3xW7,ɴFhO)~qtLFGd+?S4/Pc˳c"Ӛ=Q_J$Qv~$& endstream endobj 663 0 obj << /Type /ObjStm /N 100 /First 877 /Length 1748 /Filter /FlateDecode >> stream xYMo7W^pCF|m9qDRͮȱm6ܷǙp8ʢ.,űW O9X%;"{UǤhFI̓IƳXrJH]eȮL.b+ؠ$b$ys+3g< YEMxXAGX2R$#&{U ֝Ku+@T>@Wv)`E -BքF*h+Kl.-с5Km$# VJ@NؾL 9*u F W}4B`M6;d#Hv#Fu`%6CFHE9`ЩM[ *\U|ƒ_N<:+ܳ Lzl7O>^u Cfpls ] {\>݉>9v݋ǵŧw39t1l^>tfŇlG~٫GwbSdJ/1tom-;o-~6^鮩(Ƭ;\|FB 6]8m/&^䶍jV̪zWji76BE <0q9I2X&K^1]Z5,YNXN0iЖxٌqݴezT/7c?|63-f˞jx=>-Z=.K|@^K/x/_-MH7~fE/xD 0^`1O{Yrv6$:钊~Kt<8>X48IJprT*fۖ=N*^2:EF`A*3Z 2PGä캒!!>"|T!T]vq#Ht(KblWKi*[;/qGh r=ă8ф ,*5*Sb#RMQw[2%dmgJv[leVw ;s9[M 8OL^4j8"oǚ{SWl%抔\Q}[ɸXihXihI8 DW`g> stream xڭWK606ʨP;mn0"WmJrbpMn>Dga>Lͯ7d$a=q9gN"eLVO??>'K3u(p3F<9oE Pڵ UAg O|G7a g 76tpBC2nChVͩ[VyEՊ8yV7ׅ0|hCcO$cjrgsةD ®AܹCEXt.7WI7i12`{T4>q.Ԋ=:w>_$q4 m"t++6eM,MUj׍ri<2c^VI4,[[$A3&:aq܉rKc4[UŜ)gDj i~X! Xł ^-zMZy>dl%YoCǝJs*5-sܰbayM#R4M S`94-ϝ/S7pTUge" zRH~v&GOIa0? JM}x5M; MC&UVo( Uv%\ݫG83\hL 3A-MSY+7Z<Xڹ:h VP55Ÿ0ZZ՗jEC ЊXL⢢Yj%gaU|.M00( -vSuQ 2D .,zZE.{BGXV! -ϸ?ќzyG]ic6n&yCc2z߀!8I}CCGGUqklRʃ9D N#a4|w9ٻ_΂e ^ւǓ߹N$`QUVߍ\ m+.hvb~jE85&0Zf];S;g]86SiQY}c> stream xڵVێ6}WːIIy)is+P]HB+ӶItE9oivbEc9g$hznz TB$S&PF)i>]5MaKVL8(krc"֫V\m[[1p ]S> ,Es f2AstMayq91%QY/ ^4vVv>JFZva`H좩4kO i%._uy|לؐ׌ 'cW8M.9 .9w31(h) ZZ Iʾl {4Yx~uհ80Rjo]63mTv#yݼ{&^jw#F9H/e}C՛Nq+LQ0ۮ9r$ iy5fH[Wj:b۪ulO*bYYwVuXFd^~JylK>Vj=QA7>^w3y9 ! QL8' )4 ,ݟ@jƶ LTFiYrfAl<㫅8Y{$a}pQ̙`tZ@ LFww O!rgiaZ~Re'$X9N0;,J LYw)Ҭ 37/[Sa=eK]x??b,xda endstream endobj 803 0 obj << /Length 1675 /Filter /FlateDecode >> stream xXo6~_CŒ(Quɰk6Cr"LRIn~w!kBw}4짓'd$l1JIF1l/E4 DBX`eVYהU[>9Xu>a0Ы6w=|}r泄2w3< cn{JZ׼R/mnˢZj0YZ7iײ,sY]uM]*ڜ6W~<]]7.b@\]^^,`$R3n7yյfl蠎0[Dr hsAzݝp#F*ۑU K9}q7_YDb))|Ws_qϡS;s1T!hi?YOl[fz ##S+ Jm*M3D<~ _ĉ4-LHovx>WgH|Q[o苺¿xUCzK;=y\xY}Y~4SC㐄C$Pɇ5HႻ}8(ң=za^X֍O+=Wz0PA(, JZ 9n6JrWX|j]3!ӻlz:2Bm[w9fmo`WDxȄ*}U0tgK*_PF"$TFnQBUNàOIC^)=.>['x!F$GsRP"qoZn==j#P.5!L6&~?:+ MӶma-VvXCI_ܮ%}Ҟ#=՛2!|@HyݹD4Xƨr%䞗.e3 cs,I+}j=\8awdr.Aim0ql4TA5Yfmw;d%5y;I2&jtt>3_AQsJh"dQHbB&!+PM±!E[7pIw2բNWPNU (wΣP71N#.ǫK?d'q"EɢJ]Y*0GA샼N43uVw^MIeD( kK݁~wMArR}hpôikN+2!=fөFa( %D_` 64Xl@&.pϳi#7 kf}dlP-#$UsQ]"Ј#tT2KZYA#Cc5cxEzWԪ'5AfMЀ֩kD7:5y|Yɸܰ kX{;EPy9 }3kGhKzk^gXDDP !gˇ)r{ qZQg =Jج35Xdy'?7ؿ33u =@v;> stream xXnF}WCeZ<PԒI`0$%HbE=R"ɔ[]3s=gi4]/p&S`$ ;y/iR(_ή1A{ZI%6dVx@%L!K^q|yТ àJ`:o{F:ƨ߂K=cʖ.EG꡿yN1sS=BRҤayL"&jE\s>BE@D4f 0Ϣ'$IHG[zZ̬YAqdd@8B{a,՘-f!By\ Q o<I9”*gUuWNP9[GrƳ$r7MJn>5O}Vc!湆k)UlI NDxSU@"5D"J(m "Jt-#M4 Hj"]3oB̬5hkN4n B+#҆M8۸Pq`V{8kTK{mxh_B!ͭwiCBR\gr#TWKݸ?[TAxRH_@>;_k\Q3R '!V HChKtB6PK0G] (tv{I@ :DݽcA5]%qn85Ɨؑm_SOBŎnVKir3l5Z?4fhG݈+z.`J5\vG,銖`Vr"ZCOj60գ-nZ6 f?:^% cT̂n}>\P?@_kEM/( fsw-_K%NΩ%PLﳱ`̽6I}0ӡOJ0OWW;w endstream endobj 839 0 obj << /Length 1282 /Filter /FlateDecode >> stream xڝWKs6WpC 3=ܺ׵^ X`.>mJ< bo_OW~(h,1?pBBPbgq\y_|8=RBRuƧ+Ɲ_Fn%V'o1vT,IEi}dPRRdli~ހ'sQlB}'d-R02vhn(wI =rft>+N|Ou*E8klXe΀L2ynH3i^,gćU/ !Q謳l`RX9O5s|(p3S~WWO"o'wؽĽ^/iurgi EV /mQZޚX{#-Nnqq]..N"DB#]Mtbؠ.e.J|QƝ"DVzH:_k-:(pE @K ƄYd.n4ك>{-ZYH ysꖔreJ|'Us vfgݯO EجDi)M7P5A9Tuh0ex? z!^FqGKe} OEy^hߎL>#-o`ٚ۶Jk@jIdW(";Jc(q^8}/87T<5@4'jLiYJҾ}j}ANX ]ˆV VyNn`^W>*&n E}@m'qx;)?ܜN endstream endobj 860 0 obj << /Length 1201 /Filter /FlateDecode >> stream xڭWo6~_/P(=d[ZmqhY~x4)YR)N<xN@[9 (AFED9ʖhZ޴g!%τyېMBh,L=fk#txLD1 8vr3tRQ[,vz '4pVk &XQ.:hH!BgVb4Dc]ɶJ]n+eJyaW4Gy'˶6&Zj!vvja'^{_4:n.Z<)c<@KЃGCAlIȤm^W3Pbj1vU[QRvRy[mD5U6XbɜwOB 򬰾W̘D$P}Ђ,`h,>ʏdB?7o-g@Xk@]7y=J %p/$42#ugu'"B~i?E[d:SC'Utj]Hﳊm*F,ɐ Sj <uVWφx&4sj5[}7E8¢DlW̨qkU?4]xEPWm˓QηÍ嬎7vQސ>ZcÏrndMV^ 0>Y3V|KPuEe9KƑSE3q@qsnTB$_ endstream endobj 762 0 obj << /Type /ObjStm /N 100 /First 881 /Length 1919 /Filter /FlateDecode >> stream xZM7 W^d)  h"ɡ"gF]{a{q<ٯĻI#=Q#qRbL5d.j 6 @3Z? VZD5ː93= 3O蔐s,bmOp #xE4&TÄ):04mR |J6*FZSVA` # sҰz+xGaImnGjngL_3)I:%4YkY^Paa%n#(ۈ7k䂷BЍeSɐjH(j>tJ:1VRs`F),  J)%e(:4)7 L`b_ &lخM FG V:C+T9+ e:0I}怒㻀 ien)ѹ5@>҂6( PAYm3dSM!|'b>}ޝeN"'O&J߽ ~ΐ"l^#zWӧ 'P YlG΀\`ׄ_WI^{QZw@O8w4|_7W]8 _pgs0s>>ònO/ten1~!z s2 Y^jN:s,vXL_u?/VM߯7nf鳓=8S솲DQH|\{hANu|*.ݷQ@bs `QI"r& 7хyYG)]dJ$*a T ̱ vȢu TEW̢>ԢG-^q G4Fn5mWrDN9YfTB >jnWe/LB&l0q<`0fFv6LYl2.@a=&&"NǭI)~A}ߠ>O~H}歧&}}[v_ ~D)!s/Ha:]/<<_mxĉ " fA.NP@G#pOG)7*cw%8D-x.Ϛ$ 9y$UDYRYAqy={7:\T U]@F7PfϗQ39!xYF)2@(<$K5ٻr/ T2Ld2pb..3pf xyC }_hX|17_t"Srߖվ}k}78"  Lg[l, .^n;Q6QxΊ@~yvgx8:f[8 ~wq8 ܅bte`'Y5N[y<~m8P4wT]߇ؤ: X rXCD- 8#/GC GF(DD z: W$G/ z aq3MAžx>HE&+l޿<|vYB uԀ$/ߡF YR.vb'K$~|x m>tLyU1.X‚|uʠࡘFi6L@ϩ%~0QL  )dqC9A@@@z8:*gGYxbvm'"=lv|=,%U%GbmANLvva5 z]R pr]wGZUP5qEvπ}-eZ.UD$RO-bVڥ=?aO@~ ÚrΒ6> stream xڵVMo8W2P$h@.5%'~G"6`7{~_^ȋP$k`& c- vJu|d[mޘ7'f6.Pؿ xs@ijT4fȉzY:Bn  *nSj[ݛjӳ:tdܨڹ>C6R" < cErD*7B!Ӊ adl_h1jW{51hB>\mv.͜XAZ޴\3df4)=B"jp=b. %`P($6*ZU=Pݤ\0jӛ"1MNRE8% H># b^sk8Is;+0SUq@ )ʇUs-d8fJQta<.u3{7rma~ ~"n7#XgEFrqV1u[sٯmi C_?|6ןr%)1pjz"[/Ԇ2^o=)8zB'I!`=ji|{qdď9b@io;KyqUSopl<E endstream endobj 893 0 obj << /Length 1381 /Filter /FlateDecode >> stream xڵXK6W(+F^dH@nsIrJܵZYr%yw;vh8oF8ON~.NT"A(qRY*>w>>.RQY*AN&xdXpV/RX m}:Lյ]A X$-Ouksi”ʞL: ^c]ah碩+|N[2RxRWW8&~趗cI?S( uSyQI';m} $KdLű}\޲dZ Ku_Af[3 g.ر OjQ=JLK[#-= 9hRTYyȭxH UfZC)ܮ1_W jGnn񐆌#U3yS.K)@q;[Yj;007K1Ф-J0B~OUݘ  y^tE]rq9 u`F4en~KӇE:+Cz5M db僧sVoYSӭE7&=-`fUeog%|K2ȹPŤY\\wV,< `i_Ɏ$SIV{ 9bI\I%+̼&1~Iv;?\}lW|IE_^.aԛ{-dྜྷ8{ /@/-hٖfPpwRKly\YD:PeERDcE#'n5>Ôq/k+ē`Q[!mo'CE6?N@,Tyh Ui׷|K% |;rlE޽v [D^VGeSڊ)~2g7>x14+<(//[a'B9CwC6QS:-[cdAp'0*7ـ ~}IGw-5dih2 N_b8 E61CSE⩽#ĦDu4]0bx>j=|bYC˖me) D/1dC vS4N bB1_h*Gm endstream endobj 908 0 obj << /Length 1051 /Filter /FlateDecode >> stream xڽVK6WlHQ ö PqzA+6YrE>ֲPp >~Y1I$SFMD0F K#AJÜqۻ;8!K(q8H 5Yn}O-wAc1M~(m? ~Lݔ!eLQaot~r]3Oy7+ӣ2!Pl .nt:K q!k]y;7]'LtcN:i\up|s.)}[IȄw G8c{Χ Fdӿb {EyTn`K qb51yG&I>4>mZ/<1O(q=멭$9ٷ V͛p#d1:hvYjrv)*v{tgK,I{n~m 2NH KN/S} endstream endobj 920 0 obj << /Length 1107 /Filter /FlateDecode >> stream xڥV8 +|[HTɒeh@QXlLM쬬L$;LgN"%#I.7WS6p!1"ymK|diKۚeƤQ-woދbd@PF/+ {Y` ҈ OɌDT_Ѩy]=Dys7_0J`Lq8,3H6"g="Y[T,<Ƀ nl]6ѕ?+:q߱͝;h0v"Mwzu=Ue7&I_Tg(B4m39 Z4 DHtzdz0e0С/3Ŝ{y_w6ݝb_io_[ D䲘`d;eTiA`5){f$cqcTp3lMRƢơ ZGe:|NdvYerAQ󭶪wU&a.ؠTt :M{4C>iHVj*)Y/nL×fYЏh}0y\J#HJph΅6 "\4ݵA yٸ'n_ggiMM;Ъ:4}zs*|`֪i>ǽ>Ss0&DmY0YhyVۛdnx_X<0mݔ{ "r~!6xO,'[(_lab0%kqE endstream endobj 932 0 obj << /Length 652 /Filter /FlateDecode >> stream xVˎ0fQ"%?.RuRiUY'A1_ s>9  AB91Ky}`$~ 4O٧*C tPKv9XLs3x'}MՓ8+K7|6/#) dKb|+σ"G1cȍd%M24>v&*&VvW,)D'c3~TeX/UgȓXpyp}P/*UVɆ7ҼfSUġyZ%Yvشd||@E-{;٪0I)Y'ĐYxDŽjwJg H 0#A1 cs^'|;a,tYiV]{+%j0LlV0AfbI|(V|5lO5Xb<>ϧ ٸAmX0OZ?tru74**Q fÈnh @pEؿn}p\^Q<\FZV\gQ!bWq%͹11TU<2>Z LdYΑuPy7r5<,2a. /DQ4}v蟚 endstream endobj 962 0 obj << /Length 978 /Filter /FlateDecode >> stream xXn8+P") =@S"uOmP0m3HjKc96I G7oñhdzӳ Bh:`($emb={~uCfVS9N,qZY_yjBgZ8}:e`|->}Ox⟭OZ^bd U/5oZVaz N.ܺfV!.|:͗+xͥy +) i߰l` +W~ď?Ygm8n7NalL= > stream xYKo7౽p93-$>5rp1H"7k;mR mD~7gVHHG@sM[ *a_|m$٢ط|P|/R>#1JZ)9$b[ܪQ@%7,zzt"c8arBX@2TW\հhN"Ea,pW"pE>5X+LP1(m$0s$xp@9@)0?Wǔ B3_4YO\[@Bx !s4|+98 [u N9ㆅ72 ,I0,[`ҠI EvJœ*N1,<r 0,ONa4a[r 87u 8,?7A !#x;(N2 p$3\p\! T1VĠFcN)6 p;ga|O kt/߾}9x0>_\.g 3~8{N}X_5gK %[SUf֕sT`u썉J-QK^4N ѪR,J,o]`I\Z*EBSO칕0R+{PGdr/vJ|RwYN~[R/t#t~__Grzuz9~;~7>>ižCK!R(-EcMK%dযbJ|vۋ0"|q#LNWҿ# Y~㶘ӂrF~y,wo(GX$# O r9?_],ċXEGw#%Ox{c"FK'-}2,bN1ƒz9'ܬ?2,wownm3k]1^>9|^f5J, Ç)mϪ?\O>x-i3Z7z0F3O:ENk+uYra L՝»75NrZW۝P$|9i,=j FTL&v Q̹D43b@>k>7,y_XcׇO*|0JcDM`Wg pΖZW]]뱯VY*s c+4gX6Vˋ{bF %cix);IeClo;kx/ endstream endobj 970 0 obj << /Length 1221 /Filter /FlateDecode >> stream xڥWn6}W$/"DQZ4)(ݸ} ZfbdENËKo˙3pŏu9S`$ 8!(` n$]ޭ~9f81=Z|V+s`0;?9 E#538QqwYF1aKڏ3J( Ӽ׿*o:(#3`q>@ǡX R(lfG,O'` 307~[[@S ( :è~6ĎD3r:X"#b0'%/*պVx7 P#BYA9q23C G m(yXFk1}i[Rt~,6B:QEHwQmWˍ[T$By Sĩ[J<>!8GVwFxn>k N%8|nw~R4M=@ht)zUKyRF!QE<݌ g3*$ٌ9AfqƆ 7RuLF~vʫa2߲nLS;ܜmgmI@h0-,. it MJ(dGRoۍγ6neH7/[zg7pނ-XW3.a$h*lODwmi%alة!jeG{fǤaH:M3kGWBR~O. 32 c {TC|_Ahfx_DXIui=2@48j f #~eY 37G_?\>b~CŎwc?è~W(r-ock8 xȵ'L))dZn=YTv/S^(OAݍ?o22F#Kh`ue h/OI*|J -0Lr?*\rv[Y6!4כ8jutzYYLMs1oZ--d"6YPԋ;l`F1t{ybڟ*Y~2Ͼ ˠNc|t^i7Rfi'ݙF@[fߪ}G!{q߽wR$Uѕ `ߤ`3eN_q< endstream endobj 998 0 obj << /Length 824 /Filter /FlateDecode >> stream xX[o0~ϯ@ÈT\_I=n6M(8  Ȑ&;#iwE1\>s:DS&{ęF_͓Zg?+Mgu5=vqβ$b¨ qG7p0쒛*U5!#[;X(χAKb샍2$?;?sUϊԎ'qT.kI"A6i*[HƭB-{ń. Q7Id.͊Gz|\XyKuJ1iUXբ~"+ GJ%"!9eʎ?Y1~sWscvZ{ ?YG55~0#a(}voGɃQiD`4TGǏH"8C7'N~(Ya9¦co;;䫩p02PȉoG}O44OC~& ^2t"ѦU6qXuIpTg@DXmV;@J+eRgM4]Nەwԅ 9jH"]ąL5 lVi!mX ++U;ZL'pso&{z얓yhK,ܚ\'~&A%˼6]RfmyjZEjAjuWY=ӭR`= "C [2'o3w\hXb @ yREaf|VYS$py`0 M%ڎGn$MwWXIL[,3\n^ HTJcnCmGLޚ?Y]* l2G endstream endobj 1004 0 obj << /Length 367 /Filter /FlateDecode >> stream xmRn +8@Mۤu.4E Ml?L==?[P#: UY%D1JhX& zEIN+d^L̘8?&!?b/ B*EW+%JY;69eTH(nVc,/C;fy1l Og+(Gӧ WG5(p@4NaIX\ PI7Jypɣ+Pv?g@QAzP]07~IŠGHAW.zp.N-xT3 /$gk~]c,'٥gFed3u 6÷ endstream endobj 1080 0 obj << /Length 1577 /Filter /FlateDecode >> stream xZ[o6~ϯC`fy(`/]fHaC6D;dɐ^}iKNDD[ɺyЇ;[z{{;|C)xCB}>h]g~7y!ղͷ7a T/BY(4jvMT^DڒQoWX͊ebdU%?;?5rpw= bdC3!F`8$Q%d5VDzy&PL |PYAJĺ P3 O4_V4"pU܊ D~FǴչ[M) (iieG]ds)z-X. ΌxlmxS9a; c̿?MRї}gJBt&UU߱!Pԭ[TKSM*UPC釁OB,yGd[e+byZJ$ eԳu-n @DŀPbiZ/i=HFJ\7MzH4UԦ[Q 'ny[06Nxr{#|j:_5}~vu90?g o#6EX|9"6&j C~)WY@mME+ ] Փ&9 U~HԸL׃0̻hqF(bo7ηxOlQGX}gnZGm!FlMj#C{FC<2|inc9cg<}4Z=hBhiTL+ \s1Bn\D=bF3߽`D{,F^t{$@:}?0L 29/֛c\5A d"勣önu{c|$(cAx+be x< ; Ï9-o%+kc>9UR䚈-}c:1BK=˺uIn@-x7zSs>; x endstream endobj 991 0 obj << /Type /ObjStm /N 100 /First 961 /Length 2381 /Filter /FlateDecode >> stream xZMoϯ1pX,N$a;qx5$ο+PyCi/jNuuի*B-,.%5pm$+CV$Tj)Vrh́k[@A35%?[LM4bVŠHY9'? sÙdS1pEY* Q4 NX ΙبB#\YS Fw& U;J M( GHpAKqdjKnk('x5d*ΊZȒ|#.>1\ş5֟h Ȃ8`b}^ q f$+xi<\V# p-vKZ>*$>ZZvd<`M I)T/䝁;/>[ OUGak6u/tcNڑmm ЖMͬ:fO5&7&QC͓'߅6׻+XBd?l.zStps Ua޷{@u._m~f?￞_gn2yg87LDTXnϑa,+)fŴoÓ'a"lۧu~}}y * ŭm-^dN5"qqwW\kn1ȰPl28z8;7gf 2 kˋ޽o.Ok&sAHl5EMDp^>+NV+>2Q׃gȥW=~ r? LiL+?r?b =Df&|MR~1j1jv\_hVo4O3v_bo2<62 dx#:$D $R[OX=IABd4C}Rz  T޴(#CP?7-yӍҠ0 r{vĆLE":)  :`fsC* )4ܸ ;ZAmj־DlP|a :Ԋ}f3)w2}9w"!R]!Ubi!ė>ݠŴ?_x5uHBf/fi[Z<]3I wNyMڵ;Q[~3Fl!g"hE[!k7\J^: !{A fY }f TUhl))Y ήO.jRNr1$bq2=[/i_+K+23U |CҀNRtT)ܿNnVo˖2Bo/ endstream endobj 1181 0 obj << /Length 1789 /Filter /FlateDecode >> stream x[[o6~ϯc̬xlh2l tˆ`eOߏ"MQRDc b}f~3ClvA0,f7٧7_^QzTug~ ^ s?qZ5?{ԓD}z}YZlS}؍֋5aS(?MނY"!xo3ޥC2no#}QȩzHY DTyGyfU `G/VC24GD*1Gv^I U\]9 `^G#ĥ>n}%2CȞ'M&~4xr?'wws.0xQ"zM!&cHؙPꑡ@ dd-_&w+Ԁ;u8&&چCn@@ A`z%0"Ɠ0̚t }##\+Ts782vI4ʆHcTyzc?&waݖmKen$tmAǯ% Y!X<&[%4ƔC\BfX)yj~?-FkQV>S!XIEGyvɠ`@%wu7Ce Ѻ*<-b =_z |Jzy}C+SFy:Pd,+-+ r^ ;QCܖ×!w]CʘF_s|gϣ;PS*@G&wl=GǞ:~GB=jv+ Ȕ4~Z"e K7>@ސ@JaeDA i*++4]( yzm0H᷽)H"crl,:;p&7Me[Z*NT~Th(H05/$=rE%= twwF[c;`x֪&z`M<"kcgq)7<%Rj zaV4Uj8\"<`ЄQ sKMx1Nk:1'ʽH*->\ H7uXά0"5r,x؄zyf}bk0t&>xXI7p`̯4 ,؄}Y&&)V+BZdlȠ17JvIm_ɂ0+Z!W Xriԍ^_wu 2} Ç 2qQc٭cNŎ4=Ɵ)b)g,I^ٹS$̒xN7:;И0 NLKv*LM |Q&k©ɲLއ2JXb>-zd4o^# -H<ДOA*HGqmgPOɧWЀf2 դ^2}f 4ϫh%pD %sPrczhCZOrj%fn8aRwU>ꑽ^gx)尊kޝ\Y<$_\WⰎ n?y'A\f?(rS[bF ~8 7˛f H|8:yR~qu~e7&fNR IPש WƮmd˄ jJj>(HK޹.P]eƮ/9R.{$j˛*i+ endstream endobj 1083 0 obj << /Type /ObjStm /N 100 /First 1017 /Length 2725 /Filter /FlateDecode >> stream xڽ[M1pȪb X>8tPE`8>qۀհ_ZjqOU+=#ld`K69O@mM³u;UGVN.&9VdFKZZÓw&kL灀ຳ&u/ƒVםL*'!Xcd^)9u[3ZKIQM /Ǒ@^K ESYjrRs MmvQOmB)^frT0* :7l­p4yT|s'<*k8ԑ΅I4 F\]J VQc^-36=|w>]^~߿߻9ח^vU]]!"YAV-+TsW<={.//a.sHJ^*< 0 1@:nuB=P9όF%{;$@9Tax&|{rs(h7Z.p: ֠mHbj0PM;!GZYHXY#aG%,bR2(TjVOyv<B4c2$J3&No/Zh}׿;Qjnóvw/z~s&l H^^x./z.!$_._bw~bZP`?=||weww߿dmśx:qOXx%tmзmsF9#s g @<yn޶A@c`1h1r 5k @\r -[ @nr -[ { { { { { { { { { { @r䰦Yc"62 tʑ1L&ks~QtLaHxTIq$<`0E 0UP'8!`y@3a|CH`(dMtI[H 9$9`Hhc|QӓI m7H\T$ o#V޲Vh'ԲurʆZO2f19 OF(ҷv$)Ck%vzLH>2S=wzm f6(8Id{#Bo?'pS1zrVGVVj^ 8nf@ Eps؇Jb C͆ѦFǛ,[ 7ղ5Ɓٝ4*҇ipsO!f8z>"X}dpƮvvdpY ؉fo+ď (u 9Cǧ0g`O a'f=7$!1$='PPY^`*$ۛ902]ȽY;]<c3-TYI8CQ(E!: OiIf[2gZORf l!NYՕes8M'o Ɖ'Hcn6w\P8 pA-y9Jgz-A7Ȉ09'S*P))6"hJ0LQ)䤹톭3[8O U3l!Ûͮ!xD'Eif!_| !0XvFIcT[z ̂j:.Gj'qh>P|‰ڑ$66Gv}峫qQn]]!nla7D6?Jo,}<؆N J8l%H@歰 jI؁¸$v$%Ts꭛NR #$Uh^oN:ш l]4294.&)p`7HhYW7%Ev!/s8T#B-7V>808`U}ȆeĮkzáW(dcJW˰L$ڍip6]*%=Ky5)rmlz8oMJCn>IE {b!4m =g;2Dm *\28DQgA su0$ySЊ owr( mQ_fܽly7{r(ןjpԼq՟ʳW=ޒ .,ybpu"G(rrRmF-Hy]WWw"8lQ*Ǔ@]HPx W{K~Q xjv3ɕI qT:dvI= d.W$$ϓH R.e@ ד$e> stream xXj@}W豅j/i㔔ąaˉ7u}WYKPL 3gngfx^}| .B9h B'NBo4]}޿=zvIÃ4@ F*N1%ag갏)Y/* X A22? ,S1qH Bp73 `.2oJV8@C闇 XcSExm!ЀI(aN }Ӡ`Ρ3),3e1O̻V|>c>0U LŒ=!#Ԡ[f$ U>@ە?^RK2s[ 'd β<))O7 `LV\?l!6UǀhSG6%ˈu_va<녊"Q0NUҋd w*fu (@!swK@[@L6^F݇ ZOY\#Z#d-8aLH֏ ܼ 6imĖ s":N=vK |<,]^noTu-a<#FIZSh E7xH BUQX*EaYl i WXJE7HE39kQFy,;Un޶h)*GzYRt\Z֋vH;#ͬyvq_h+<# G߶ lU{ Ӈ]O*!qYwYlS;.,dĔJr`̗W/6 Uͼ7at3< onm`@H/6kDkzoYϝzsG,49eOKX[*Aڲ)Aq sfZ)humI^]܂p4} endstream endobj 1183 0 obj << /Type /ObjStm /N 100 /First 947 /Length 2146 /Filter /FlateDecode >> stream xZMϯ1pHI@0`[P I'=("bn:NK6: t5,>V냽9{ )-d=w5D&D S%>h襓RlzȹQJeFVxBImMCB~B)6E_smKS(]9Hzr/AJ".ADt@ n,b-R{ Bzw{ueT*` b$Ak,h/Kj0 Rz05R0k!/`͆$2g#Ղ )u qMr犞 juh knWF%@u4sj+Cu 7r5U+axif\A-\9`y :N:BL^ف+0+0W`6\oQ(Q` CJn5oxKf-ӁY9ifiTp9%q,PnM etPR$RTPhTTSUiC͘D5cw55}6ٳͿ~ ǯoo07w_%lt}Oox8_ݼ{W9ܻ_+x5cB.i}LHQAؠ=Ƃ.anPCΏCQ&[&vDf0"Y#GAywݡc C^`\T&pWOeZc 9dI@N ʞ>[t=H8tvE*$eSJrv ADZJ%nC࢑88T2A樿pS;pFeJ<{Jul!\:]Ni1 Xb'(bvkQ*JDr`1ܩug(|&9S&چ6ɌDI_Y#G,1Ěv$6Q}ݠ,ٽlIbOpKFYO Lf*Oziu|i<m y 7Jk) rYRu7$) 9 l+< \WY{Ta;mߊ{O"8truݯ<9{rXd#`lR%4TaPk>WJ^pUD.-i6hu}C:ײQ- >JMX(I}dw9$8 ܀NWº's}q)guoŵ endstream endobj 1235 0 obj << /Length1 3042 /Length2 21388 /Length3 0 /Length 22902 /Filter /FlateDecode >> stream xڜT]%'hp `!;=; =;}{7=UUkVY{mH i "V4 q+k+{k ==7SfGJd`HUvV @!=P# ``0q2r8hm 650ZMlp6v&@zVP4#5@A t2Z#JHk%ᯄD񯿴v_L4BYC*@ni>G{CZ#?ܤL V@C!(.0 /; ځZiw:4٘&6tt~-Z(@-2Z91 M @cS+8_\A@ @@'mP+ ,\ˀ T @`3wzFGfiɃk~ǎcۢ׬iSavjXc}ak_6ϙ?; yŗ(eCf6م[$ n򤉇dWER-4iwKo@g!(~8tKT FvU! NiCԧja-!BYVp@DH3гR$%<x;'ScRa%GF%.5כKY>.'\H*(ɞ9w;Y Y_(>^iY5har3/yHB hمZ*oyW?8JnRBp*K)H]P_k5{y5{y|N;J7sN#`%.2~,#֛wX}Hkư8 v)B5zč IhR'eyGwoV|t+_y =c_bXg =q1[ GI|5£0T$3 V@[nu~X2UX B,2W5i:u.R g9ŅJ|ʈHwk*OUoy.Ik *Y]>" 9QT{+ATr{$j 0Qgr5I̕p2=p1!kBڞ߄7-, +wB\{UӿiT,MwV9ɣkJ7waIx*#pi4OPl T 4^qOIwjFok|r$_Vl! /BBoӸ-6*jsKk9{ WqD=X{<{hobwѥ vfr]zBsw4(瑍}< 6EE]%`jqzj 4y!qBQ]ɉI짽%0M'[ܵa fao﩯Qsw7|緐$訝qޱ KIYl+ZIT8;-k#E=qCtV FV&,8Z0K^Uޏ-iKB[byfկ?xb~w^r1S=-Q ,?spb̈ZSav[ز*ur޺]C*Ge+w@50Hw% \{_y; ;wX"S=H]GPbf{K|p(YkU1V;lkہSg$g.ɕ"e HiwmK}CwhS596ac}:+ ` VdUL&C.ˊoiK*#^5#D)+q+؆6S {I#m4]IŹܒ]Fwz@O.> !W}-x﫽h|:/S({1I멮CMԮ lHgp}nXmJkb@kqbSA-m>I(Nr9A@Pn=ꛑ ]juټT`3lE\>"a/ ,Dً0=K eO2pQ?,ÿ\"S'N=D.Z@UkXg7jzjx͜ݟLռmAyAac˿էBJN(ڮzAU8f1 ֤yzU; UAD8Kxo`GD䇼8o#2ePX46:A.JWXykdk=/7"RNmQ>LN*>Hԏ,Fǣ Dw#S1b6@TZ厳_O0ObCyYRM92ٗ([ߜQ0ʐ"moo#rjeԨ []̈6ҍ*Cs[F2G'ngjIF 푣oeϴcU1Q9bm %>|FXޢimQ#aV*OYxBDcVzCELAzNs"jQqt"a&p;HCFb~vZldW_k,PȔ*ըPK0Kl(Aė#5m\D{.3y󞩛QU_!Jޘ/R" zY|~ҵYV+#c =(HȜۉ"iJ7޷.ʜ(DUjqVsl[jTϓz/3AP2U劍CsOK08LO/M}t ?!O _CF9̨kmTbЇ5,r]eГѺs?0Pp_2TW,ͣF9dDh9$ߊ9[.A}]UǍS$1θ59pOW%V",gNu]TZ3>Q%@ Rnit#kfN O w2),ԙ$D&`WNEh{u޲|/DH4ŢHvd~BTS3+y>'gcB,JvG`p19 z.wt HH !砮ctW譭)zGt&|Ct5˝zxl`Sw DBDvt#E>2yI9mLJB Em=O&?$?7HӶ4'_3yhc;ocEdln#d0nHDh'PKc<ɰQM0, E:MCrCOݙ Yٸ0LG3)Cmj̈́5$ۅrJke Ub77vpw{{u;ENz\E{Ψ0GCD 'I"3^i'SkvH=MU0d.$-ef2}cJT褚;\h.<̲H益3bsAs:%~ɖfs9%P'*+ OK`._V\e(_0)ʷqC>}@1[imuyjUGg=;N"^S5)$1NٴʳD_ȭ[DIS03]WVH}K\K2]k٥0n쳕"XBgN#M#}ی AnQ>Zqx‡ɰ5X>jqqo7#,0b41_2c*n/v( gtB|sg:DEZ)FFRH6cE:&3$WiË{pN+k[`7qol3/M^i@W̆;""H/wk$JG ˗7hmS"}ȳfA?bZyLtYp%[Ҟ017"+7M$xP8LdQ&1jAu^VUׯ"]=1MEkJ}ѧ@ @= B4c@!M/2@rPG&˽|s[bjJ*|K1g4cM7zƥ=Zz16hʉZ59Z]9f&|\qfYbe2RJY"0k]7g4LMgܯ\a+riFgo8FC0{'IlҶt]R\[B~2xKsmX]`p}"*"%d,47 ɣ0_ ֙ܚ7ų]PcZ~3,&EVNQ[w)N2LqIYjʙRY܄n_^ 3R[yOnLXNT)`_H_qK(Ysw%l fx4+6;MG9bGY?q9lްڟҼ(&}Gb?'^/)QzF-Uh…/МœWE3CerT@-tP*9YX+(gegԍsh\SF^b M (\N‚;-:^0\fT2U$I*,Ӓ C\c'=j-']3>&u#KQltOnيl*UB4e->0*W  OIV9LFTRPF&(*:U h[^jo?hzQmM!*`ƛYOJGj/8 |'F!&>}10o![vxd\ 26 ,_ʝנˬ^R|Qh`Mσ*ɑ cn=ĭ_F梂u*Yb'Uy:tHtz6hIoŕEhZͫ="יVoϒ\lUŝ6to[}]ٶU)Yw7_R`eO~,u1;ΝSτG_a qYy&B:X}XDpGdb6ҫ|4JL#-\xىgDwUpa$>F5 >S%SZ}1y b_X1X!orAZ_Y=$>Zȭ;OɖUBzD!Q컎#Y;!\a( m;׏JGJ}LOvIˬu.RFz8fi"oy_<[5UNghkftK@ |zE GmCu[rR be@šIl+?})CI~/+,kj]$Du>n'aj A8jr^ڲ~ b 5 MÌo[#tZN]>1S v82zc-}$2TH'>{W hFh{.)XVh1@U$- A9KnXuV0LTH+x7[uf^P0׺C!UIfע9fklPkӅCG8l0z\+{B&bjAȍ7G5>$,~}<9>ʰY-,ߗp3'SV iw0{bÆ{9 m y&_6!j5n +! `POEeTr2p;ߐݠTPT3/DX!UP> 9BatlU%\WtABwZ)4$j7Χ NFaȸ!m[^~a3;: =tF^=_\;"j"> >Z/Jh6kC~!?⺵4D*=y0qhMEU溺'Q9ً/Ba*b*4Wbk}::lVNFN/K$YF' 2c[ƾ;9u %MRAS\̨|2iL]+ Eᓃ*syJ-}3)iSOs$%ȇ⩦ȁڵ]-21%Dam8 Ĩ3db|1))o\8qp,L9|ŇS.!hO|i"SvbyTW2^c.2qvWEmBg~">}c?K+!QHQY[vt Ca)4*g;Pˆ?=ҸGQUcDL!oшޣ$/"?O6&jn۾TCkDvE(] .D m'")+wBF>Q\]S,̂F,/ky*Y-FE]f7-nuzC%,voE V=e-+v/!Cn`E<$ AT)'wpѠnN?T ,p~&tDS]!g M[F< f}r[j M,m 6l@&b]+\ͦ7jcxܻm/o"DvlHHA1aQsLI*~̉ήgl}ڀRw>).ukzL9O9Ө" ƛ^x}PW~rK\NgVwX7Gmˬp:2MūrĜ1gyoߙqH}ll?bzY(:֫1f&=4 ='͚ExzlVg!Ij+Nz`+zNWo%pfYb|6B^4J ݸK)=%PMFP( P>eS!{{]3W^gBSwZS&ۅ t-9#@=:U޷ϛxU;r;XU0G}?2U29`1# Լ¨nrqj='hPVڇ.li~TJB) RhUSqJ \A}lC"*sJ"u792V{8%Enrsmg}捪uجscҩ˽*-k]w~aWF:q GY,=:+sX1{qOD j6h{)Lxm k3+H?+ygN 2vYLPnqGHHѭR F9eV)gmUKgs,n9یuT8qˉ% 1ϊ\ʼ*s0ʧfdpmtb xɤR%T<s+DžڻN,N#ˎƇ}bvk>#td}כ!X$fbocsST߻缩l7GעrB `d!g liV?.s a җ_R„ ¤1%^6egi~*v< G@D({r1V 1(سJ`dŶ=^È\ZweXc7,۱.lKs@JGiV=oVOlW4r!3-Zx tIx[!94 ur$\4/|(YOv.~gH:5\Z7(Baahm* `hݭC]ӢVӳf|efG]zg/_y1C=G^k/$oITr+N.+劾>aȋLSl5=JvC hUR#nvd,>xƞ&$$Wk{M;JU wV-{<t-Zv|?hrܔd?,oepŋ}2  wYd~kCd&MRv}vW9idrpe-4`1_gTmdhDe]Xz{0gkrsNq]^N V lCz̅˺otvClQX65& ԕ~ 2|TLL1i/ |0vCEuLo7Y4ʃ,SִJxBCM|$ŷd^_UFțhao$X)PQ| ]`rc&bB@YHo;};(=˔2@ԯ>{mhq0ĶXg |rrQW;ıW89J_CGOp>˺[NۓpsvWbG.um+Vt쪩ΧbUH ̓)܎ HщJ/M=#tߟS={"Zq0G#rBbF-L_OmI4tua ݥ`IݡMNHw:e5{Z [#4?å?\ c<:^e+}P*K̺EK[\=~NpIfadz==|7o'5Nƹ/Ӧ{WދKy]`6tOQ Q~n6GOZø0(I|C:g{^'h21^V#@\hEp Hmf^&SカxPcFv ] 2oba{LզZ3 ņ]GrO=Î&EV`R{̻߂&C+ ziޯWwqf>!t* )ޕ{TA-ym }ѱt!4p:xfV|g$L6#$gf+ ]:Ӷ-dnA@!@xf#yIl׏ 3A85|D/t"‰vq  1-.\S]#0TB_1jd^%q[8`ٻuy¨u^$Q +{_ oo~_kѫbt+O  ^>dUdhfoֻl0H+`GT?l]HA}nih5PzN:~4o6S9ٴ=owM9޺ȯ)#C)sus7PS8T[sQOoDU\ jx,zs c/,8Ti"\0(9O i]&(`OZh1T-mH\ތAPk`O&j̽y(jDeP,=%ɬIgq;SyŦm2ŪKa,dAS} |,*56K՟/w,$eT{ TwNK#jO&f$$X c]A3s*N1E\a2zuinvӽ,_NP*mni!pzr:bH )0t-Zi@X@M*L S|XI7F{:e2\ w@iR=S^b J%R1IPYُ2۵w jQP&DX9ji8أ&pԼSI0G?hP#v*r}@AדV3w&eZ*2z:`$xh;?IAtN:gB712|?x4Sl(9Ub= # JkHR56Ռ7oߴqbLr$mr'팯l%apV$i!Ü毙b܇x;3FVȺGa xRY KcXeCO8KwE #46UXO[*Ec&^u1;U|Lre>cgseIOv=ލ\*%=@ UskcQwU{zkGV@3%ԞE^$[lO`&BKA.|bum&503vBۚz1v8M%n#f qg>OTN)K=v \x#d;a+쌏!)<뾑Hu>=eS"gJH1imaA8~"u)* vHN*s:_|ٺ Qf+ TtXsa*$]|n̠qڙ<r2T<%OG_6l#`=x 쪻DjJM:};G#چ^( R`.e+):n=zIu|N: *J<"#Fh>^@N*`ĮuOBdM)mc">Mecl2*H   wGz?g4k7:*Z]^Li<ᴍ08FVw}̙Fu .n&eOL9]kp>Z(1ef}zm\OsFaCJE݃~4.ڤ7Z [Nǜ'GZ^vկgSWO\gQqXKoYTY@G^Uf(ѡH KG]2\uI-7%.9 rM0~|IMw+07Evv~K&zx7ht0wT(-*$x:0Vc(X>-'yd(6 Ӱ<Ueڛ_İ^2ɱt.?q&k8F mke-j_nU":86o#[V%۠&V -|Lܩu?Z[&7^PeuUn|Tof.S`~)#kdܪQ%O֚<Ht *9Ib9L~ūf8QL]S6KG5~ ULf@+=GQl$:`Bdm yV\VB(KsVJOXM6n Cy]8WFDƁ 3ʞx3M4!/~TǮZ>4\9)kGBug|񕱐HWF!kva"m^- klžX&~h!zSpEgpPUJ+ZЮjzm֊HkQV޿ᱛNØB˿a<2M5~E9-6=a(`>Π)0kj8}S6#_sJ#3wlQS̙rFRv7NO} )2NO$ %ʦq V՝0+۩RR ʺ% RDRlKf\ G\Nh G#i|mW//QW7ii?ucEԥlylѨ=R^8I es(W¡; hz tȋ6 ڍ Ԓ*qF>ua]'6"H#H@ns p=Gg6^ؚz&rҘ$.%mhj5G Bj%kC!xsE^ 4:Xޘ( IjD&NuwwuAw)q澒.]V:OiV}QNbCw_j؇YPM!J_{:Qғ?׿k FU.›$aQ %&yieaYˋ%TG݀]$$sC)V'Q' VWAltf#ϠYw$|5z1'wF'hHG#կ1A]1П}~ַ;$<3PDi@Ĥ(p}g15uv O ,Č!O&Ao΋Ұuzu|#S׏`hgaC;/7%ox_Ouyȏ3V?o5`:{3^[#^X\-vSx蕕c~W(J7!6fXPIp@V=n)" Vj*} @K.2w+'i=%2DM4 n]Zk&=s}4 2YI\a;,hϸ!dT};< W5D~3բa>#2 n۪%ſBTXIrgE:0tG\I̅Xn @tR;Qun:Zq; g#_.Hkxr}eI*Ӂ!xêvM'Rǀddpg1!5=< wXky ^_kbv 턆J?F9 SWx(AqS_kL@ʩC"aw^s*2쌁wu;vc0[bm_%0g̹ӶpT/;&5}h:f nd?s^Phe'_2@1@ d G{Ԥ[g/T ,QHk.-FCu9ٟcϽܳ{Ce57#\o,>.L:6:zB#@`n3䑶7|·Jދ'qwGH55mז$XgSuhv"b/f VcFfs@y}öprny,fW9곷85m^GP HVmw2nr0G?rfL`+Jڛ15}•f"3J9 WNxr&G-8W%|!h ƮV"Gq9HU@#$. XM O5N5)'{Z>9, /;SPT0 D1SrB\Zc ls!-3D,,|Ta*2~B3xǹɱb( 3|\yamxxށhQ_Cy"]!56f ԅ;m!.90x{:6n+BnF\ rU~/x@m1p}aF\N5,"][_DE2:f/j@ 1-a}EL҂Ů 0_eL 3 >&#FQpR^RhJs=8EUeXW;Fv6dyk*#&lk9Pc2űiY^:2@f'> S扣tK͖/Vśw9eWsSge'rW:>E.Dy[P6;Y[?[} },M[G`<#fY̮&䖪u}ЍPMnJ kx:"N4:ɥ#}3i`WB=ijHʜ@xf!a&疄Th ɠ"U (*Eeō(Nu#DTql@yg4V_wUH1*6#(QWsNh5"G-grW J3/qR<^du:`,kyys ! ~Vjj:ʟӒq P]^`GAYĩD]ÖQbm}cX<:LOWV&xsIk-?2V'7򫓜sW k|g,tRˑ7r,JoN.VJ %P_kU%<]l77Ho_&x.#A`&zhpA!Hћ#9H c|-ϵ^XH0N&ɤa~ŚMMQ4JIJt<1AZn>/Q,Y4[6#{b-K"zI& ;ih5'pL) 5ө%$hD~"#Cym7.Ǜhp[6_wQxC,oTa)]u!Iv,mvf\gFo/ȪyMz\j% 9tcP5=/ON$T>r"EUyiU B6kK*RR,{lj0%>b&dSЦ2(d赽'IڲdP瞐fDmr w75]} s\,poMWg[]ÎZ,EkiEAW=%dΤ,uY`WSU32ZQ*u$:#Pmw*{f~G/A"־N4EKu|`H^ h=%gb}aY`\ўM [?rt⟕ԡLjNj ~XI.<h^5Vԑ7qP-!z]VށpTf 3Wn6\)% 8" q˱?F[<@(5*d%32w*~kdFcQoY'(#CorŐzqSӃJxWґj<@[v7N]ˬ:/B5 .R]$!-W*Q/i 7 2(;g'rRc\n5UZ,6|T\䋾nMJ:sc`:,L~PUQ/44potLR"V1)Ay!RtW l5G6rTJs](wsqf ) 0nb ~;ozcw:CZ|Ep獁Qfz't$g/Dqs{>Z*j{ٮi_.B"D[91u~tAaᙊl կ7XGEQb5SU|TWQh#0!fpⶌFik:jDgoTA8fV\cdS##\5qB$_H. D4"'sw2xxve`VSUkYlʯd\c+dzhÔ-} i.g(/4!,]ܝWnƍMŊ&Z:\߳׀mbzvWrPv͂ŰmIkxr6h;ʵS;0H\':f|mx`Y=04Y]DY\e#Ua"OJL* i9> ԒgW}NCAYU]ZKʽ Zu $s#dX1˴ﻔ1FPO̧mA*mCNsGnpw47_3CbN,/8 v9Zsuחp.hgjuủ'E +\.``4>^4׌f;J%FS*UՅO6U GTZ5qͳ_PaiWV !4hfw81 slC~U_3e {g}G@.VuQg !{TH_5Խ3JTSs]/!R)HMWücyX% ,Ch= /)$x4u{jHC#ίi=g !´1,5iBM"ÙT2j$ՔtvIǎ:M3Ub1T5{D-b xBAR Kh$+a`ʒ3}Q#ΨKK'q lxb.nsRd$@'nnb[iS%ŒT6CUmӫ$\ɺ|X+Xx:ZY+ ŠfgR!*~H_rbGLf^.]ꢸ ŋ=[UQ;^tJbNXȨUDm3Ct[k)1*ۛbDgA'V$l<(%l08I8qlz%H䄠rv\#QG lY PC4H%Du3y_;Ͼ4XI+Q͍=&H^@R R.3b"(D`32ŒJ‘DhsO6=bFr1#D|O3*5LMPFu5}o>bD52?/Foʕkי_}KiquN&ԡE1)G90;@jm;3lC-8)vA mb1J!<ٮqj8~o=7ZU*Vxu1& t¦zìh:GhKD"^[[fLJJ0,7o,m}l'?s0ًp7M?Ը` yY}0ѩxaa0e2X{WzYUbB;ZJ2UgN%LNHL#t][3YQi0OSA:u5 oϰl2pC_AMknAD03PF8N%d .D/U۶I\n0=G.3gw@LᕄZ"@e# ި%XFLM)IXcyC~1;)ޠPYEIr]{ƨ>Q_`qD֛dE,QYL!1\[Fؚ9p6{a#=q1 5F 0ߢ endstream endobj 1237 0 obj << /Length1 1409 /Length2 6309 /Length3 0 /Length 7274 /Filter /FlateDecode >> stream xڍwT6 E҂"$I"5@PDJ(^*iJK)RT^Xν_VJ<3{fy6m=[5TyA9 0@|ll03o?)!!CA!O5pcg?| @J q4x8M&@z`>/62.Ph@0P܎6gxy!.h^^qBPsd&g4^R6 ;øCPP Ѹp[( BBܟ쟅`_ v0g(@KQym!h.9Cq_C2:n?mP0$͋9 r(&ٟ< ':p-;@81TE" H 7ƀ져R/4 C}3O l0k= N87`  kec-o+jɩjp_AYY'A€?hC`\~qwnHG!D pf A V_)>vv 18h pb7[P[c` 89q ~ahEVqM~s4#W 2'cE8Q  I|%dj nR}vϋE@&ec(_KPԆtja#X|\!Cγ:(N|l3gAR\HV{8 VplӔu=ΜZf8aV\g<2upo/(QIՅAN"ekߥFWU8wv"ŇA͚E4 "_>b{Wi<`9,,I3x i{9bO_,e'U;J^yk决/n*tJV%eUx\밲e*.{HMFe箅d0H ;R`oK?1:yNu /xb:@#VdO-[K]0~_+ 4霛>v/Y3f9ƌL% fE)o nk?\79 \kmev-GQEbgSrNw56)rXwCr%sDO)E$H(9f[x`-oSؽҙh["}݈f<~R"-~*@Y%|}[p^EԃMIZ~.2s]F.^V4M+T"KAǫC+Z>S76jϹf'ĸCGSao8.wIB\VQ*jARG1vu;j?:58γYS,tdq?;{? .5<;xⴗ~@Q٥^a#[}"}Gj$oMgE|uO]% aJ6nwIšx}mY6~t߮+&pԧjm8"Xq*tt cER@[MA^cQr.U [Org/pk;P}ۛɰŢt[1:__QzvԳp`^ƚ%)w?y\ zMG"bM1dUe=ͨ7Q_UqX4al^in K{یQ)B/|@, +h_G^ vdcC/IoR6FroE5^55 G-I^G#Vss13ÉlEPtH$ezQ+~$DUe Gg~ ́rHbrx" vES?NO iPx_,˂Qi_.*z|;rƖ \7RtR;ĿgA+/ƙ4 cNU~U,]ѭu9=1IiS}e^ȅgZ'Ԡ:Hlz8"yۜPnFm,cO4n  \RƳ|8O y.f3xVT>UVVsX'8ŕ0Dx|s,[גL`Y #ՔiT鄈 mJKJS3נdk"UYa#H:-ReNat-a}Zku䠠# ZiާM|F][*\ٚ8l{ƴdM&udo Gzf+/ 7\ݘV|BjZהaEuQ)mȃbOw,[/JKMȌu-x:s<]V8yLmM:I;]Y>HB#~=těH M2=b3l[ (S!W8l<_`~>"i\s2(NOO6V^[e_ Fy?2$oTVa3ƿㅐ aΝsVSTh-93YB)nan~y/$%H.M&9yf]bztn5>yħlԫᗑSQNyQL{ /yJ\(Ƕ$>Go.˾"SGm9LO)g  V ީMq4Y ;Unr:5HGcw=.ycɷhSE|s,_V֟mp+d;L).&7Qɽ8d`mre{ƷTrӺǒZf>}wLr]jBAJ}++OMTrшWoRNżRg}^b{bikv㍊DO@ahy9 sӳi|steo\M2%H"y|hH{# /~l=műtrky֡jC'R9p7R 46ϓ)VXXGXtBwxk+2ZYewvlgA{|v^\-iܓ[s\B|џ4vפׅ%\r?+}JylvA8_y^y޷;%7>P#īOg]W8\Kj0zWԷϒMOqkPة bH$!= rm(7čJ3O`)ꡐUaN+綾k # ~oP輸z%[bJ!Q%znj1q.~XPL$jeJxT7uFLX`%qGqΝT>%,3@cFiA@2M 9BZ!RARW _G0>jbT`y?:rIbH^@!^ }=^i5O閯4Fdd {4\붕,uinh-+3NIDgNFȇ#=LKdXIH6焷̷똫ZT d3p^墑D?Qu+jޣ Jz#G9\vx:fO(`ն% O;~$.;~+_ֳ+T?5P: TϏT`􍴬FvxS~vl@]o/Dm T? D{w&U7п%5DjzsW=]$9%l*VV22,_Z 3qoz94_(X 6\ӵf>FD%K XL&ъ%-~c.x)J W-nU"kXc9x8@w@ou^<%)'м+vSN/ttz68~\;M( |JPe$TⲒzQtcb|~&nzNp* &-kֹEeNJR#^!]h"`nmg*oXC.=ӦB]QND. m2igr;DRhm 'f-‹ bĿF ]N;gt*֖T4dgЃKL[ c&ZYN0hNk$w$gj]Ĝn?>a3_:]۬nDi Ousp:a68`ԟ=rm+oYD1c܇;[=[cYaGkz-p;0wom^rw!ia#U!n4ئyL#3yx 3ErP~ol t!RKC ҃vuw`(nRwUA:}G|cP)^K̦5V/S[jG] '9RJ*'۔hl՞*nc:6paɭ#diO-^w9'_H5Sxnw>cȶ)S?QR2uE@%RgV .͞#7&te`05U7`8mT|6~շpVWVv̞TLYJWԕHKl#G9WLW; Zdt N5'0P"RFhxD0v1HEρGïՇ[CT;)گ ^wP_t mC[fZ>N`盷_h=֍0&M.Ϲre@4>*"}4Rl wa ĸ|ќ{N2?&* [5\7|vc~FmxrUU}|Jd_h 4 K&D$6ldk> stream xڍtT/! H %%- 1 0CwH7HHt( {sZY?xvH.i aHvn.!7ȨABF= /i'0yɀvpP r q qqyewʀ\ @UFN[;5:X܂%N+ BځoAp+!EH!NNWWW=d+ A `WeF A{ 0kr P X/{w8 ;f @@u99m"  79(' wy+'@;}eap{{0 Oo;_} <l 0kEX;;p `EM!?- `7+;uܿ =@"rN`oO X!`[ O{l|?|'И{@߿Le A13_NmU mY*NJ ddr&?h |a6p_޷_M濗! \o ENH f? {o{:#@~6`kkEBFBր b_-B`` 8Yߏte@S |9y, n{x '';~Г~nH .6p'rs9mc/{r-sA6PѿF?$_' v[VA*?KR0'{N959_>|Rt*vYDbsᛆ8/W^1ZC_[T(u$ּn_ף~Sbtt~Mt.VQ42VƯ}]4aq12mNJ7zr:B1pGގ4Zyw11WÃh&g 7"B?!z)d³ osҭ^$&<)epXm[KW &NZbs':u/Dr`6Rsz-6>PN WGmյx^U9|d? pS}[x8+7qP "dZ>X`π˧K\\F/1P{)w2yT}]%Y~Kn+kœ"6k>IS\=XĹXB!SN7yŐBQmu'$Յ`Ǯ^hMڕpjnvS덥OH~.K\CzzU/$/<Ȓ~GGʅ־6 O_Gr9y #Sޔj/7^S2ym$HߞT43ϽcL]A7o;}*EsMﱈ61ܷLchZbE{P/" vb/hA9"&n^Uj @M>Ìƣ5_Qz벸=ɢq3(')r3Fx27gJIϝ>+zRǗ;\-Yp .?oC=$?‹7v?7w0UsbM&Xcv4O]o|.K8/$f]aiTS\Q'&rXٓ`@uөnoڷKꏅZ2rM%b^Z$o=lϊ[9iK61jd QIhKpIK,AK=4c37L`0cQQ^zjMc Zu0YJ*{U͉G>,R4=v_QݸYntB`IsoeqS'-[ᩪN w5x Db>"]|kU+?ԓҗ^c~0=!?qO4\dzQFFʃ!?dzO53hܝf^ߟ:N? t򵋻s&=`z>:kGK<}r #1Gi􉛚h+,J/Ds&/醞dVc_cRuEƗ/?Snf.J-^*˝dY^%|eږM[Dm%0yszs^^<`,N6] #aIz8J;"'찼@5 *gq?aP~w7JԫEni媿$;? ~^}n:Q4Տ?=9_xKN yv~dUCR!o,qhV4t.)Jq0~=cfDQVaw%R|fp0uu#'4\ɖnđRf'WL-%嶘}q̶QlS`C5ҔSZD2%6?ziK)'e4:ji;`2p]Hℙޣ+dbc1'H*3 &Jը<f^Xη6}Hw,TrLf@Yס.K{* k/⎹|%v[;aF I_D Ͼ#N)Ė1X4O8}j׸-m C&e)TD= ÃxTܸiOap/p i^!QMF1h#&Qě6TPK\{@2[)ڇsUGڦ>hI%PG4 i.\ar8s s ~ $^glj x*Ѝ|2.t#|3.]z'b4'~zi^&sT \]KʌJK Vi9a&T ^Cw_J)| 8_/vLez[n<ӧ.Z4gTX׋T-i|=1eHy 1 #䔀o~ ozUz)A|U2so tD{WZ~?_8]$ڑ6쏄Hs~8L;zpKk5ShpP{дyy?)%Nze>fnhr;) ߀üXf&Aa %F#e/#uu`h$DEU5\- Wfܰʓ-ۦJU4>4kh;ݺcԂ")M=1D! [b~ 8ONk Qx&AD6Xh/+xt.,^d}:!8fhE#ŢV<{Y EB[YFc %\ɲ^yoDݽqY`8݊6m#!r@vONoޅ]t %L647קյuՑf~h+a1 xST璅[o:K`zX7$m'ϗ$MvCeGɠ*?v$I__P>j*aJGA ^/( UE"4wv:dDg|6lYhh nK5EZnʲ%NKgYÄo+66wڛ9ӱKm\%_,k!̯3̥`u_Trz_o1IŊ7B{(0FL6P?X6#[!触TW+JVj(hO{N>tFYPy]űrreAԧ*w ~MC&Gcx2.]YaڬLޙ\>yw3bv1wim9w ,JFmͦVЎ겠TbObl^^Tfk֗+N{6 bֹæaBC'_T2'BQqH-,K ܞAяwXdʱA:ʅ W۞@%4p Ǯ wT>)6[U{{Q73x,F~1dk)6[oHvX 7StZ8K=zPMC2>Qi6O˙>te"~f\o1W6=i 6'c r zBU_7=I7w\0V\O2QQbu/whUu\)[- [-w \~|43~K2~gM0Lt8ݣȩ=l7m@+2Dڈ .ꊊ.YѺmO^F(PHN8L6ktT+Ruw|pbcĶY:s`h %tW|A9aj a&j- }ǃ4:B;r{Ojq|[ozaS/'Sk51Yb1N syjV'K2(z\vmh=m6L"wno YD=1Oqk DM g2z$/;ϯmB>{*v-ԣg~#6/ȪM:RmB9Iǫ;y"j;|PE6:%^n^+K-QQEWye$vRetye/7hkE@CWpwNX6QXMј}VI޽}mlvQqJɸkTJRCRi2 : x7 HN 2m1|0=#nvʸXhGˬ6`y`K%jdQ:]x{jίƹ3B, V`+f IXDrSIGH^ȳ'N%),8C쯀&?x7a/+OijJ3^>ThyRFc^!7횎aF<78JJ{wXNV9Gm +~jWޯ)W9و\z5beo?NTZ3WP(En$FT|jKES=p@[?J^)jytL8l?W7whƸajġWyZɛQ)a 2;L*y+dD ק*X}G5z {FI.;_=n;d}&w n5k-ĿUۦv0`K?Be4fCzD{Ēe름tDwf_ν4 ?==pccY:XI%BthS]QUVMvU9;vveXn@4GˬM>}kw*@)GXymH[=bbm ؚJit|Rܗr1L514|4[U{1YV`U^^y#+-78/3L͂ a3@ف9 :ZC-)'늈ضvy;vS\C CϼPFO}+\ ^N/FGS ?'V7T=g۫)R7^N@/&Vdq'F;NJj)h!a a$Hr)քʏsgF afWkYl'UCQMxM岷^3(؛c >CrpXPbع7f9'W m YeXc+ QԠ *b'+DM`7IXQߺ.icV.GPhCE'LP&hkFt~XGf8 eW$iu䦞= _ι9{sf4ycPܳ|}nSh#2یB^2Դ)49|#,h11IYR%}xaLõ@Ewz|n0Q(c4am?1_s2Ɉ;tPO nOMK |4<;iU:U$0)8&tsRxkL&*C{G힐MiUݘEXk$4 l젧|ו>Ȑ |!JaO|¯uQ ǩNvMӋtQHgA ޟd.Vl=ycq''SZRwcA/b*_Va-^<5YEv hu 1옆 ۠E| O!t!o+ʼcJ3Dlrc)!s5kU3نgx,7l'^YĖPIѤ蛍lB~Zy74&idG\lkx@5f/MiC u>͗/,^a]fw'qe̋~{̈́+_1ԫ0Ϥg 0򩎞״y)֛ *bM`7h$g#e#Sxi /FFTݝz "xnytE-uaEDήMSV4"?_\SVFز#T =" ["b.3VNUtMɍST`j#ǎ endstream endobj 1241 0 obj << /Length1 1386 /Length2 6039 /Length3 0 /Length 6990 /Filter /FlateDecode >> stream xڍxTSۺ5Ҥ#H7 & wAjHB$t^7J](]zQA^x}kk͹d30T`($F$[ PT!4c$f04 T,PD@4HBRQU C!ahN% III(<0 8ܰ!`0H#K {{{ B('y^7 0a^0(=hB$g8/1 C!H(0Ðul$W?ѿ#p #H/ Fa^`8n PW2 cBh8׌¿`Y UA4ɯT0v}+{GBt6Ex´T`&ۜ`PJ\\ =| ¿ ~;31`pG 0@tsEps#Ik9ƞ`0( 7 iݷ43(@PJ@ 1@?X-# W}e?#^?s顰̅xMtk;_YWwGo?_v#| `UjPs_ՅAn€jPB:a-+Vp /e77 3@0( |XA\w4]0YW AAMDL`|~ ,Da!쌁GɯؙhW98rLV{[0 B2?Ȅ8UbP欁gՈ" zX]tQeg: MqDmLПg'Dl* XG.d44Zxzl.˞#wN+-n"7Z^w D8N$Ytfom%7k2SiCu&'NwiW`O4(4zgGl)ð {x1)QMmX㸅ȣc7RՙݵwۍF=UsRպ\RfAd'dPYcBA{hۊQK,Uw ^4mu gxš? D?|p{jn+Aݥң"ę7Ej:"v"7[Q$[>S 7;<Qdnef&NJ[DVҡ5r=gUw8(BJ3{9Πsuwo!!|_mTEQkWM%i݈{1:O;̴LVAOE;747LE?!һ$}MaR4͕zWd'~ 3C?~ՖSv[&-Nn䃼@jie5{左[F׽Ts UIȧFr):]JZY4%P!M?WșhϏ$ءaSzGQ4cQ˚]WV?X[t8 4"Se =y<#0lZp\7.E{:pU"U^hzzIǶHaITX>oxYPb'yq)F~Oi7&lT?ˮge(l~90qV9]\|>\*Zdxv]W}[?+gM)e Pjo}q}G.Aj`{ƴ5=G3WC*IDzZ3+W- u˳m7fHqw0LgJ+hR7RI[<]6C3WILggdgltyͱJR%5j0[0r'm>8i(s>{meǏlp|in|;ԙvgn]I0S? !0j)n-R}E:/!#G㨛U9:o۴?5f>b?^\sNMܥb=!ڌ8wnc\6΂'2,Uϼr`}Ʀk^%]q[9NJ [x;N&"- 5z.6B<{5B޾K~'\}BЄeG4lz}]g$-!JXo*T2.?`gl`)V !d~oѣnW?wݑH ]@ O7}oz]y)1X R|[727r4UE]zaEi-U'U7yYhc-b0kx'8tx.Dѳkx%{@! f njuɁby蕋Iv|Ho J8 3$%ͽl˾&wIbpa[rfR cG(]S6!bs~P^Ξ}<ѐ&A$㰓[v²s&>'+Su oR!Oωm") gK[A!ţըC~moC| [P輱:Rǯ.n"cd67wK6Ù_'Sp|,F|a.2))9 \++ĺ| ,"bBnUhME3ƢQ/~;XT悔 MqwQ,;[П!%7QM9J0XHtvdK.8JpS\dYiہQļ J)N|[!=͚QbY%F~=Q?cґF՛^gl᦭*Ҫd_-Ei;·'Mc]L]ecgz z 6R kSHXܕj^TQ J̐e4>c V/cbje`rbqؙaΌ O`kn_EkV2BDKW i7Y͎rK%ȑ/ɷkhԵW{|Czn,)v_-vwı{ e yѼ5OR d;, ]kA\8]vn>&אY8Ca"r7q֚啢s;<5 Ll@.Or%Ռǣ==+䂓6sS/n2~ }URڈV0fo0pj22fm˨@.g^pdt,Pb쎆DY0g+*mռ?sngS~)nFXN`fLe鳨N}t2m `^uyu'cS]0 `%O)Ĕ J(RK0)a䫌  "MO-5Y@+횃-aF $O8fh1*N>niȩ.38Ep:Z=g\P_kn+:Xh߄oqʑxXv:#-"]SY 4{r#}1E(BuY0ՊcyOB4/rky8H»rCo 27n'EPf^X|;8Ԃ&Q`YKFY4@F3nfyXܤE)b /c=u1r5|!*x]m:1LJukgsC:!a\ ݅xVfO^z3z:G/NT+t kNQg7ʯ62OWNm7w|PlU((?=$F_d2R^_EU\UE"||wp_*IA؅ӊ)AĨq\ݱD?jTI?"+!r S ;/B،1ПKfv#{POlduk"'r OP5KֺAyY9XbiD*NQz)hrM3Sv{COEW=U#sSc/$.gK!Aj Cb%\cV 1B&m.T 2@"fUR_B>kqQy'E w؋,%t=/齗AA]ޣߑRFɓfab<Șp[Ci$q6qnyQ 7(%CYFXfr9bR3ȓPW@яPHVrJU͋7p,lk_*Oh}'yIk|N-LKR}şua sjR8Ė8w_noUmNf S`{*js,W|ƩI)i"flvX=5S]j}1w,oPN5b* ]*"KzKM%)։u.MCI.LDb#P3pAk˪kSE]u.z_|>M`qX>u"9=zڳaz s}%p^5`,hoN~Jxd~;B jwgTFCVclSd,iRоTsIXa-s*:EG-t>ğJX"[ss=d_SK hǧ'y~{j2K` ÍexlTI&yʞZԁ~᪸ nUmV}BWQ9MD`Ͼqn /ο`i$TעKr3ݬk-=mxA] Hb`#b\ ^y)Dgw06|bNmP`f&2E%{ E{S0d3)Fy!Pש݆mO/O&h@*-.>͍$lmKPYg5PCk-Ǧ *\Z&_&FLX?o-X=8~8 .+"=`Yδߜ7W@Ce+37q㼮Tw;?Fz0| /|;ܘ:o) Ds =K-a鴨\gWE > stream xmspe-mc6;ضmtl[ӱm[;~{[ﭯ?SO1֪z(H$A.j@Ff^333 B hbe7v4fUOwttP;а56rhڻYZ܄ݜ]\9 \,s+[ @LQI[FA @-Nƶ%W[+S) ;lLAfVo 7?̝j" j 1&511 'q3?@SMGp,'`fe0ZXś Srif@]mmj1{;W@ {w'"-5-?2.!>%'ﴒ_,U.NV]fI_-[%*j ``qq}\SW'' ߤ3 ¯.ٛXUITBL-|[EmifxpH4h"s-sBjD<!_.!|U.xi03Uq\[ R`=u,@b1*BJXISg|"jPg,C LwWw) - +u .tf9kFڊ]KZsL8^iqw}Hϐ J9%)w4Z^2UnJ;C"P5"ҦާRtqM+;tVb,ke^)lFI Z,!&rgGa|n$뷦_7O\4x{ػDi_(,beQ Kc iUa7׻y3mI0k (_9 3Uh@S;Ců⓻O0d6*D|ĐȰA.Y2Y 'sK>Nnt$ [_fhIsze69`&wzt|7 bӼ"ƕȮE媙f iӯ?= ∜`nCh1y>w,v%nVɺI/g>ą ;4--C1ޡebDuyUWLO4QʩJеjt_d/LH 3ڥ$!NLrhB67g׏ ֿZj^f25B0F~߶5 ه$?x{4LeG0G^vPهH=X{j2ޙW֭ :d9Wh% v)qm w:?;7ҼK &WNras;y DFbqyɐv&?EVpK@z43ǧګHcb_%76~ohͥzz'=6>%X8 duN,&S*F`+~ ?$m89弸'g{Y0-B(N$!ʰuu+q[C=Я ta/)S^r=0[#*ge`&,}4m<÷c,e.Э% q>Gj ΁tj:Z M8mQUKn@F^;L)'$s[l_wEA6DF!X*m~J5&gn悩SMhXa<^<è@b_!vO+ZKCGz9=b3R4S:ޮ@ 0DÂyCkuzbn) T9v|" Dqѕzy@GrD<1uJ$V`y^({?nΓ²]P8:`Ț3>* :+sg t-FOw+{?5kKCI3.w#D`I raN ɗ>В) 8\{e}rϤo +$C\Ål q4&5Brc['zɞJHx]ZlU#V9=!&.RJTфioSg5{v3Ls<8/+>uFyɾ3KL_煷 ܗ$\P4=^%d86B#\ztt g\Qqi!+y[᪮W"I4MNy9 "߲"g 8p[\e}b ڠL6HV R_lo$vbhh[Wy˜w^]&C<\}ER'Vv8U75E(`V,Q_bk0Ƚ*ٌĄWջYF.q4y& -qc`k=~Xi!VC }xMwWf|,^LV9@#JR1}2$w:~MQrOyn ZF#ydo`j6n>jMEL.%riaȸNZu 5{2d)f}#s$T`s"{.}b1Ϗ,c,:!DYqד~D;Ni.o1 XXi$R h[J-amٚs!KЇ'\ЪwcRf̘Iwz:L˒N&ѠAQxIζJޔ¬tL^A\/7%t8}FJp9FMh, 5gn7ЁSBdc;lrzNj:hƈ7CEwhgfzAB_ c.smo@S֊hڮ؀60ϳ{:;ӌ'XKt^˅.`chtڋ^#1ZNQ`|! ϐd5N5;S]Y[De\I 7 ҜۤAE&FqQV+֋jWަZvzoX\1/a\:6CKNu'ycܑ9͈r<*qܦr)L#B"!JZCʼns2ŁFE)MkR[FITߑo&)8o#TDEpl?E, VbW^\mYg$&+c) ?ذF!7^aUSzrUfKJLMf$FiZqQoxkiUV+L\ER]J҇%"aW_|}i7Lb8{Kd8):|#X'wwVCKW.R*n E'E \| ɀ  |2R0ΒyZ72=1L¼z\u` `Yk{{TdBߪTՏZ>$6c?gεřSWN+{0A6±2yax)Q,=A>d  Io%5Ħϵe[vx]Sc}tEL9Ca['t3)!n.h@v%^|uqiC/t!Q`/i\_Àp1uI~H؃ ;9{Ѥ8s*M}}r{vêel?g&_>h܃[$\~QPzl8-a6R^aqmM!woo>8uu܎E tBkƴk\,YlP&POx<.#O+;LԆ)Zx1lqxTǿ\V,OXQLA/ӚIp%S[WM7+YcC/(AB.%)2׬,'G7`i \(>h+Ry5cʌu=mfYnʡe cLG{˟(375 HITʡEL:lf,,+A{*a &e(6OuWjӌf0gA;]KشAC)v ^Wt\Wq[c^Lf~[d펶7#Bpd&&͔6V-7HG#K8aPNleoH_1G5,BG?5-Z-78 .C>V-;^nZj? cGjp&(49'^7\mS37Մ4votB5W.@ qunL4kVG PH' kPwiWRcX7@ӎM˧"WUA,<:/p]"k|ѵnB0&R}H7#ja|BTmPs?sY(S@8]!53W]V[(j,?C);OGWMgz0QF ABuʘ)ל'Tޱ=y{JpʖK5D&Y^IkLg2O$q59F8FJ 9+=OCWm2pveǐ{6r~JSi|؈MNJfs7 6T.z= cͭ (l\L(gr ϒr;]?a7dfFOj:ש} dwP;uBJ9z8OQ{jCNL#nV\,y I'O6SKT}gUUfv޾*#JRfA7` 2U i;낒jAG*Ϥ:U(b)|ݫ88ʰ5u^{vx_IC4Se,.A2̃Hšt Vy)9k= G"K/μb>*E u9kO#41`9X*Jw?/g?$sR X뒉_aH|* -T ~u{0F܊% "FW |cY/U_6Q1P٦eʃw[*M"<ßR@F6DF1/k0IJ"󫈏 Fg7,NTl. 1vǰ[xp16<="&p7z. qҹ aҀ>#@[ I ̒W9M?He;¬wyC= %Shm#?"ײ{Q[5EiUپoUwǬ%O\Q*-l% i> ˸@ ׏0#F|{Vy1S3LO *QкjLVU)g5ZcaQ9EjL])q ;an4`{dWؾPRKHXe*wmћF% n%ӫ'W1a20V]6F6SWr;=5RcjWtY5\P5Q\r:˹)mۯOj IHYR4]2:3a]hƶfc\lչ!K:N5v'1PnWσ4Us>ffv`c<Ǯ?3H>N2p1Eܵd}!Ln$2^`Tdh=BWss-04KELbn~ӽI^ r@*dO~,拵w 5cAi?Ⱥș{^:Hkw+`L8kS?Ea?1mcʸ-T0v(Ov2P/<1ֲrV'$T %EF4g(sS@A^<|b0(7@ĿKB+k(|a8}}N7Q 3b˝O%뾵-1YA“=@mUAŕB9Z#VM;%]`ҘJQk[ZpYBW=dEF.y-)lۭio#-3am2jzX@1 Qjj.oaԃtJjfI^-U+%9@I=PՄ\tIt3C ;vbXQ&9p}_qe]{rY|A Cx)B '9,+L qA\}Z^^f~ra8ͱ{i3\2ET@ bA{=MOUSC+-zXd ŅR_3t p_[HǎPxaRkmQoj*EB?MB<#"+;BÿIIK_jWL󩈥[B"|>Lw#ʹ߆N?xwv6 {83{&n)+MJCswr(!sG>X?+%j}cw ь:. 81M,K}YMf_9%Ԏ44Ad{s;nvXd+!<,h[솰~ WwڬdԶĞ_|֢ {_T-qSeX""jJ6OJD;Bx  s:`+<-L'[#K`S#cќBAGT"S+wǦT 5ɝT3yʕBy]*RA;ɌM׌@ѹ cЖD(Oq۰fj2@#~^HAn0 9ӫq9si=[Op&ʁ~J 9,fO+y ۖrkI?G`X5B \[UOBhhZy3)weK"`."6[a=`H8'1 m<߼έUIJheowZ}=.})z{ ZB*ĎJ:ȵYߖn)NTq;\W -Xwd1]S$9%܏jLֺ$qrj-M;*k*ȹH9]w YoG *߉ީ Ln;kP@7@lCg E,@]&#Y}.DuS?𖌦OisXSQ]rE?Þ.ȸrH?ww2QŊTaďP}DfE`qJK:c.̐Zs@T}Uë9o~\m|g g=H%0$rTIj꤈/3=gϊn_xO.ỽjL4mFyAGB7uIѩj ҿ=9`;6c\L5{u_SwSL=U|xnPTzy ASxJ-1;3ddikއ@Vi/ot[\Wg lUŦ}kRj!V}s%x@GC!=l4Ԭq@54(H%wrLwf0*>\0Ca$+= $zY=ˤ8[O0`{ ӵ;NI^x9E\N/gjN!EL(*6Z*z /L7%Up3^Q+cdaVL);gpy3)r %1ܣtb`:j:kuuVbGbAur,az+v>Oo5gæeP.&ڪ1Ze.-' 7 gBZ-v׮Q~xoݲ-TQ(V]XYUo-Ya6N_GD5nl.n>L:P^ڝ_ݷ @\2MK.>$#.dz}Nyиa)Q9m’8S[8;TL_戮'+_J2,ƌEC;ӷbmuɑ6G{l+"DR4.~LT:({uxNНdYKKᾒ"L`F?Vӿ?n!Z V\H5Ȋ츬 ԫfF'oǦ\tX7 )ZU[#7`*B3["zu#]?{Gѩ̆NP7h_z1a-œU{q~l+I.Ҵ4cgq W`THo̢2Q4'nc't9m1o kϻϤVVWmR3j&5fۯbcw;T鳜\чT{+ڎ)U5ܻ~:#f&6qdjr-[FԑFn37u1ܒ#pANoF{Iz-{L0;Y7YK7J|A\+Bo,wKa IҮsdu0YT K#zh3@U' 5F 40rM16?Xz@ zNH9\ėG=2"dPv p{iîT4U{L"*g&׵6{Qj#aDʋ 5hDrIǃn_s7ތ:4" [:+9נbwn4r{ݖ_>S/I nbĪSpa:[(Op\k5UB"oAԔv#}ˠu>~Ƃ8aYbzl9u[ef@3C(uߺ(匿βx[⯋:>hڻ)ֱl3[n H+i)_jeU6a.K( ]rTfXLg"&tK_pU~>u'p\h:.m&%ۼG fuv@PLeۮ'~БLj,s€Ip8A=;8\g<rJ++]kG>sk/B[dl,s'J!o֗{',EPuٙ!᪦i?ڴ^0xL2eiOwPG?[ҬD@= S@mR0sGE\bgV#kv1s!8Z?E!n;IBŷ/[>m+BtIm =5㘸r8ͱ'> stream xuSyQa"AXHx\dDg"B+1+|&WY#]AĆ#t rt&TA>Z4s:¢gBvP#X4L,SB ]3i̜!>@͝[q?,fδ6Ptw'alPXp+c62@gH4Lx`Ѹp;џb B;E`B !@5|SGa5 V ku^(o>H0fn_T06x)"o1WB;Blľ  îWALd3Ep?5wO-47˝dq\xӽsiiWsYw! 10uL 2)5,fμ87 `px.1"`P @7C0sN0aB0 Q̯4xf.=eςAp+P/AIg'ϐc0nYXm,Zn+t^fD6r)m`9o9L{c" j湥i0=gCT~Ф5EkcϝWFWO;T&#񺓛Qz|%1͏(u#%[҅S.x^Ѡ[ꨂJvU}E*&6޼d(۴dzt̬]ӣ뫻5S^ّX}Dkm60dx0t~zli^Kɚv󶞆{k'֩#%ILf=?x$6wjVurhu(237k<]iu4Mтָ'" ^&?S^PZo#fn=q-ޞ'IS 6Ɖg'v5+:+E-%F#/7삯O$1w_H\W8PAݓҨ@BT9>2hZJ?U7[qf*L&\꺪#oXl-Aih\Fѹw)}ʭDءx5{b 2+: M%w:~uxe[ؤ=j*/ާ z:V]q[e"Y)sa@&YDtd[~Lwp[:eMY1uX|ƹڪ~9qluL,a$+o[{$mr>[4|x~p7>Qi\XZT< 0\8e@<2}llDUޭ\Q=D-)p#1ve9k|U\3)J)}AؾގWuЉ<گ4kli3[}!FW7=81&A[%E R9etI犓%?Hd)g֍{}:drވ>~s@ҞhReQ? {#nq69WxKKԇn7r겜p=*VmI.xu$ #c|?M>ՙe:Y`{Yt2C eͺiۍ{6i8U捞5 K֭^]%+ ڍ#VE\~E"Pk~%lLs+ęyoj UVHF`iͶ8QO 6kKZ$M sSC] ąhv~B1Ja:`:>LcKRa-4&w([nR(UK}5*a㧬'R4>o R:`4V̷(2語rnxjo \s͓T҅ اPPhy`#qRãvEjA fR[SiNuC%eNy՝թsG9޷h{cdE>!Gm,)hi|-M7Q21dՈDZêhEm 쩒\h endstream endobj 1247 0 obj << /Length1 1626 /Length2 12201 /Length3 0 /Length 13047 /Filter /FlateDecode >> stream xڭveTܒ-Nݝ][ 6$8ݙgk)ٵvME\P7qsQqWpc77|عD͍]bƮMs3)LJ@uprrЪh100W?=.֖@ws;G{s:Qje3**iK+Hh%@sgc;)@bNpp0uY՚ 1#/#;`l thjf߄>"?|`J..֎JbjeWm7#}|x].WsO׿j̬]팽>j9:[MhOgsKcg3;s쿦>{cGG;/֮.vl5M]?j[ZXiv37;= ڿv `fnQ@S'AyW% -fg`lxc1=4nW+_5V_}Ү#Fk kOs3%kWS+Ǽ̝=R+ԬMm 9_H7yEmMq;Pc \ռ?G+fu FD `d{Y,ol 蛕ϓMZUWcǦ/_Λ{"`*jڀ[06#;49XެVRXWmZ2rs C81cGӟn~YDGA7XEpbPukYnJUpoFYŠx] {q #iFSvZ FWu=h5!C~<1,w;#Q$֮ly-aZ-潕[{4`X21eFI'blJgāVWɣ{V.h(̨S0&R YOIoAvF.W!߃"|PkWA&0ZUI[Wfi"2 ֽi'L3! 1` $%MjNޓ}.g[8YB^u۲i]}5y htQMUԼ=E\Yqr b$:;gMu<#"#dy[ES;FZZW`N/Ѩb+av3qn-sp/w0@7 ( f"9q$%ak) xLE})Dofbq҆FzKNiw0!̼Űy.n $!`Џe=NV IjM91Vao,5Se[.ٙT ^8Mk} 4y0xi.`wy& '_Tpx$ ~op~X'Q]g9uw,#2S ܅wnkKUr}n^N_'} V +WCJص+O辘S DJs`m ،V͝P`ЀK|}O̦x?m]dUVɣ_sc*E̺cຕFHtʱ~`߇O{ zdqS+; ҵ`~Ӳ',JѲF nS@} 0,Cێ/M6ܡ]^ '4!_ ݕYŔٷKsGiV _PGv;Nd2Y9FUOP(bP){kS! Gr,t{C9_TMŵnC$ӭL|WPa[' Ơi>'G8P {7ɞ7lHϻ\kת=# ̈e;4"ŀ]VWL٬)Xq qPLfpxDnl8kd `hX?4[8?Hp5|/.CQeh& 寓DTyj4piyXzIǩII:=nwaMGYv?@T.t\]>|Vs3EA&'K)E㊞ ߲f$!> {jx<ӂ2ov3T6p {0b|p8#Q -= S)V3GqUks >mHQ5|ar=Ωpt6L'B[i6'DBiA^~(+sd_ ˴ۦ+qF$!PJ9\`j qGuJ1m#Z<@ց/kmˆeQڦ7QOKXkMguPħdW(Qc+O-˺x~zGo _MMZ?N OPJ\l m$A\wNNNRjްh~H ~7v%ߥYqջ#ɻZ,J_;>Yq5Q(Dyz1귽;fEcd5IK>[Tk_T>qI-e/~b]&lsf蹱Y&\HOI/ͥix \[\L5g{-^zP55uY^GG>g/%?B/ յxpM2r+QU1 sO5lFN;P |y޺eP#kR{(Irg*ѣszdKiL`K˶ 4qNXl1$Di@{Vۼ:2&&?!Av#$k,>xafv/v`"Uʌ,3",1S|n|"`M2vI,(0 ۠'U{0TK/A :&jbp ؉'3TIgVv %>ɻj0׈% Myc 3%CvGLx|MN%9*BHuEE ۆgߌQ؆2êYxZ_|z$Notw;K-cQl6''(-jy  {!ةMtq6>9>f=h aĕs7`DS F/^8Ce'>$8mVQѠ]vVyeb@,cDݤV|̦& Բ:Uls} ( eePuTOA?cV9ԕ m6fSSا?.=#HC GOf.;Rag3XyhE.APYx@k6;,/R?g ooda)?~95(G[? t4&]ٵsʱs >?_k_PlB6IxHEOxW6^ Y@Cy?)<6(Sy8^/] pư3?. 0xtmhܺ0\/.DqT0',!P>yhNǒT$fCS ٥bQ`tw9Wu,g*% ՛&-У!rt~^K9ݼtE0mS+|[P- "c3̉T:|iTʰ=#u" )gZZaQH9kw)l* #߄׿EtOFO:\Sy`W6FKMStM>PSHbBc+{u<\=?=3C#$bd%z ֗xi*~<;n6&˭OCDfȅ]0 I¾^&[.wXŶ'q *n>Dj^V3  V\Jn ֝` Ӓj*6χ zP*mJ 1$ՑRPc>%%D-pn+_MyLCR3v97'm0 snNI4|?}E\8ɖtW.Y}Z ?^WI̽+1$k}ƖP Pt*Vr/F ; Ɓz$.[9`Z’nb?V:%Ø 1B z}<. swaDfFyEtŷ"3T۞C(B DnJV$ݬl]Btq-N4܁} {C N'TsU&ަK$^ECfmgGrqbuw FnKtQ\b6k`$$ю d&l-eb+Mn8;,P>٦bC^e򚏜<83r P#TyT{ӈ@NRZw_+xӍqWXe h ,f'+liKR -\*"ћ4u¶GZE(KކO%*1FNrzDe>yJg+ܛixȊ(ەG}ELּF35*;~֬ȼ8Uτ5!\ˎ+_W5 F"{䉒'))ȳlA!%5'<؇i5|QXmsqJ̠!O{g(<Í )/KE8^Q1BM%Ň?/¢:&`LoAhX03>p2Sr!j b\cCG5=a9]d[`4.޵Zo(0[(mU* `망eDpbI5S寗^)l֟]N#&s2n? C}A ]AZ4Rp>`(eA"p`6߽L;5ɡ̵J{ {w"01EGpz&/.'LkoiXl;d:Yn/@`=y+/M\}vC-C J9Uh2q> <}+Ҏ}cc 6h±~y fQdеt; ôFchㆱf<ݣ |h1Dᾌ 3I" | 8'9Mgmì5>}Ov,ܙ$`oD;'9M3i ]s0L1C^Q_i<SvM_9GtQS|1'a4hCoT3ݨohVIO+05D/jL}q ]E I,$D+t{ 1  NW@OWҧMiPPrGQr] SuiYrY%[f')/d'Ke=>#e,98TlxӡӺddkMآ89N:*#.plF,}AT*;JzAp:sN; :g d h!7Qd7gwgަ$xrQ~a%G|0d, KFKo(ܳ_թ%n{cΝYd!K5ק/׻P0aܤ`ΧnOVF1Aߴu5;uq_SțFaYPQSёsY $PcؾFYg:S?cQf]v"u|+$9z%~ d`)i}H:G.uh-PNC_EI""ȸpIH l-3ŗnEE<^χdˋGЎGSe/Rxq@|<0uG>˜a( Pcb\jpYhKX HM:َ ųd)z:k-LYweUsr/>kXXS,]39M;e_28Y8gIYׅ8G6`vk%z$.eI@MB=?X#|#8 c!3Tر R~wŴ`qZSR D $pDN?_N.DT tb0.Nbҟ! As|*TTHRK]97퇽?n2 o("A7$|;WG`$AN.ūj4yV6 CծEvNY!uMZ4qbퟋn1"}-?҄6{[TkqQl% 䀼o6g"W"᧟:af{{ZFuE恅k˵{(?sb1QˢBan?ɶ#pդ{Վk(%Qv~O+x˜\>QH`+ v.kc UdYUzZG`]E,$g=}WL/F> +2bJ|S߹ Fhm/pʛݝh+-miʆU/kٰ67a\Ud=F+uG{.I!}B6+(iG-PK"C(ZGPoLD[58߻OU]!TƎD@ b2kg) `0FQ.8.Ym[llhbI7ug  ;1&>[Ft-1[U%&(93ߜu0 )"9 |.#th~/$q-{=uz%yʢ[U8_ͥH0!/֦)ѧo9 XV(Oh Pwǹ=51&j]~nnMkP[|*r8q͸&&B,' HY|-zLż=3eCJmtUZsMK@&ρ}ϯ)e I#YH!U^BtEI2BrީEH0UϲVn|EznH,Vw }&АAj"1;&5'o+&c2i<ˇSyCUL()@NUn'dz䡅?m.ŕ!w:^agLV5DBm".DhW. SՉW~թ`J4)9ޞLJhN" ;X`ȫett_d?4ODsDMF>}qT 3I/?;g/[¨ /H~HObqMpR2ɘ-D"j-O+F&f0b%?L'lmW*a=/XI *XQd=c¾.m @6« !c (| \fV4W2I/+,Sn|c-d1%b Yޯ<~m ")8yzo%uO#!<UaWE;F_'r!4[AGܪ1f!12j'O7gGqyڜ] <Fm 0RpG| c%!n+i4g&cbmGv<0f7t؜<$ k**Ơ& V#k^!D.T+#r儬:ݿK%D5I,GFUӣs_| H,j_`VG{]OósQc`Z`ՈYgK#+nIp'\f┄`Sf_k1#1xn\R8=(0לV 3ߵHHz=UvRe!a3wp<[`QSJޔ^s$㻇Gp RV <*I=,[;f7t4Dĭ`;smfK22AԃKo/f)ݭef輽3CMe*l-t!5GzbLoDYDE9S{7R&2|]L0iPw]gz{0*QΧ&#i#rҎ3)ѡ8LZÍqd;Xq GaQۤPN 6Q\nC~P?[.QO8ok_U%{/yZ3į[H-햣Q$:χH bjޙ`U0n:mJ']2kʳ[u8Qz[O?~)Q@:TNk=T6uʎJ&̬ q$Go8`z\|aJ}va S5]-1|,kGznL&ݼ>y7!pq{Fu*x$2C1U:P}g;un2[A*  @ѥ7h^)t(v{A2_ 8ţ{ӿ_ E9tTj`M52Q Q?B#q Λy$K`ܙ+\0xy+&˹>O#_pbepU`uЉTF֓L=DLQ&A,%udx,ol9hSXHr::kKͧpk yk=uOͧ+;kGcPU *XT.m0rCħѮ?w(xCm0npVť?;( N [:n#ڬCchC_#.Uj(6C DCY;|w eT zĮ:fRXbA#?HiSq>+ S>1765QySxS _CH[:*8ap.*]Yc!N{QTO<>QIfo'hA?f#qX 6usOHĐsl;UB`:ڮ UXУJU.{'I*Ŷ #PVO`=Tw8+~47VV4i +5:k(8ޢ\tksvsq3scҙ7;@',츌}>U=i!۬UIgJ{]yei] k L5մ^)%D7()F-R@$r Ӟ+& r{ܠ).TMng@A8oAq'ųyZ:PJ'9YC1(RqܜJ]s6u&~o(Z2?W$.`a2КMwWAa/78TCR.4xl-N$$>u>|C2OfLVy]6 бh>屜ݲ*U\3 kց_G +U3\/x3 c Sw-?}2{ԥWz򯪞&Сʐ˧j oTZ Cz~$}H|a!2d~6΂(Р}v"E֖=CJ kQk8RLes&dn'f;.b %]P_Ӷtx/ O)ch=c/ִaˍD,^]lS ZY<|xﺘ$A"j`{ZQx :L}D㪻V.ܜmGg)"b*0?qyQU~=5EEyf,k1Z;I 2r=N_]GoOƟmclq§@yQ"}2 endstream endobj 1249 0 obj << /Length1 1630 /Length2 18023 /Length3 0 /Length 18865 /Filter /FlateDecode >> stream xڬctem&vv*mb[;mfvNVũضz޷O}~1=qM\kIUM퍁v. L<yK[cWge{[y{n9ze+௜\ hbio'fhMb@  jdinRS֠O?&ct4P}p;\B_; UPԒPIʫ$v@'# @h ;l}ۙZS3_,aghb atGEp:Z:;}X:̝\`igbjOfJ__0E{gg'KߨbΖ{&/_Z#K;g X@,f@p9;Y'_9X8mY4qY303[n:7ӿDPM` 4cw@2 B -jc#odwcY46FN?#[K;߶ۙBKg Ko%W3:Xr虙Nڙ UĄi7 _Eon @M_@ynd[7<q;{FGO?jW'$k?{ hlobR?<)3 >P֤Z#־?#w{](C4gҩǾ h eo&E''A~bFբ66Τ~;t'uۏ G$?x.f3Gʡ_7yF~$).NM&nK9j^oˮdqЙ3/X̿Ae/XEgTeV8x2W,%3Hٷ>QթMԙP2ԣg8*SvJb;]|`{@jT3r-cݣhb_+w6D*W!3ZQe/Y_qQ6myb|R[{u{2ك geKw`~57DIM%<^aR #yDY#-G}0`4g9ՄmvjG5>Fۂ˽Om@To;DS;e/%`u-}xbk͕:4e:l̸A嬧%X[jAN t+WxyZo=(M5bxe}h{k$MI4K5հۢz48gVLSF,pH+Y\hzvZv U#N ^pq=A>.re!>Rr88`4 Lŗ(ݶ( or}"v|<(&FsTpO c#psT꬟ P &i2 W8tD-|WJ;Oc*GmOs;݂ku0%}Ϸib#):J&~? Lr|UXDezyv"Tt\}0uca-e:Z+g2&F'Z&=!tyZ7 'y(=%5?L {kn 咁3vH&Ǥ7ۑW:l1>pNڻ&ڔi1ߢY. aN+rGr;!N66r}3q)`+C?=]V\\%8=2F*o<ݱsf D;,1w~#[<~m>ًdY'<{3g&(QÕcBVU ؙ j&cGbFS%E?fF) B<[9gW8 Jl2Iˆ"s6:L6>R~C 3$6X^0]GcXw`B rpHCfy0L·D/+/_ ʵIa7.> _.vT=$|} TK ]u-!x6>p~Qz=l)3T?$ɢ>QN)YZ,>0 L)q3)LDt" t?:"RHdF%pMDA2Ng8Yk >W82G p&˹Cw=9܈kzIa:ݹI-UEe Gg drOEgMV {OS-D_#?5iY 6?Q 1asޚ)?sX;kjry`õ& dl38廏*tgz- m𹢴qq~ܥJyKY-BP|a2<(uN^xsCjDK5~Z^Wz/[!B.}֭ڵ*]Ws+Gi?Y-SÒ 7p?!X(:q!hKzFwu@MmjVd;)albH8~]l UQWA". K6v ![IBP$Qjrf iAW^I84 qK 4i/՟ 0 Cãrp#3,βGs&j؛LjEps7ǔocs2PF(nkQ9'Ff} AH}Hy~b .Ꝭכ:orgƲ57Lȉ!7T?!/-W`9wBg^/j3m U}N10X7U\%s s6=ƒmzmg"_ Z#On.tu`[#Rr@ATLqPVNqz.T`kK !IŔ5>ٻR=i$Wڰ.D:D MЀimo򵅏$^\z5߯ǭ)SDoH"o2ˣϹ?޿\ߗX}c.Q]Jz.>w4R-=D:],*Op/xrL6D~^BDa"y#L/" Ml.2LF>}`~ҿ{~JClYlLŤэ} ߜgu1|\hJRؑ)whEÇs▯sZĖ/Y'Q 6ִ[O&ە)/ i18'GM\>y|/Tt?6OVMy ڣ2ÿdMHGl|\;?{StD{,]v6{(9~&Ou@ᭆ;;7L1)4ǫYLXKfb#ϣmg9?bmkN&"$ڢ{89bGQin#o dSq= y+-|a@#A{eIIx*jDe|#!#|K TU5zUő;U Bb#&de&8|$fIznn 1mBIum$ EHyMtKwXz,9( -^ǖ5.;G<&vIUh?Nđbk~pUrf4&R'+7moea(z _O ;w~@aN ZjyMN;8Lٽׇ!*ķ;Zk,zyMȸ[$z^SXBRQb]U8ѧEbtiC/\YnHɟXeXnDLG Xlzu a>G{/K9-%.>NfzMiݿ|⎁p6-^<g:: G9ntrO~9 |Xk sYk|.f2~ΟjW3 Nh;¦["x0rbih'OFKo)yCR0ZkD^ h=|UKU(=c8R0u}vr "U?:!^]>@-5)F [ 7!o|zJ,ZLE1 zglM)] f"OpnZ𘌣~c:@H/Y.Hp2pm*p8XuwyWuOƂ~tgtmcEky؍62\%Vpeh}4#2;n&vw=YeQ:\Nx+gOI@2ɹ_< ;[ ~S&oDu+N1#m|8 s+X}eDu5tNEi j kazu ğ `nr^[gs, hkX>ah;U*UěEs2.*WyP '@zy*C)d\7=' [L0 Kg~X@(kevÄ=E`htwO Aŏ5ݩ̩ 31"ҕ&\1ӑYJt)+zȪO R\Qe[r#{F$-+eU)X]NwÊQ8xL ]z韕V'|Al2_YT50Q^/ T8ɥbױ9_9WvYcbz΄/mzܧy*RtxvsHV{sVؼt&c4]~0|,,(Ws֍lasq(6z]MyZrrq՜~h~p$Jcd[ՑvR-N!Fdi&ukns$M@mp#]1jHҤ}fʼQF>l.Viz`pzkRekr wIgi;V[H!s)$(U#@Ec 9n'-qc~Z~eVt411,ME\&z[ xǏ+si`3? %ߔyi 9 "/aˑ=nUI8+J5"{YB,SSZDq\XF폅 `IcsZJ"PqD,Glicg(>gnO"=ݨ'(U| :[eTu(uX9Wcgo e0QE_=b:{;S: Q}+ kj0`'|_1ǖZ#_$3+#D 3q}Uc:Er];guUBntH=f0!38B tP|h Z.%˓5-\vlѵ&#T Mگ^`"KWQ$O/S*ag4mML'2&>4Q8 jdXD0FʇKMľXR\G;`%@}?xtarоW~,{y;[E ;%OȴX@b #^p4 ,V#+ƵƑf,k}L1.&l]`yH\ rzrika$!.cdWzJaFAj쪨ϲDS[vϟE$F&V4h+F]å11u"lS^`I< gWeN@>'hAdG@>k;4B-2^ҴzP%(~1;³RʯkvU2+C εs4M)CL+;:Db9C9D1DFhDfk9r%H?_f(hFi{'%yC'#-%4kz[|}LssRnva8$`A/ i?sZ#u` 3Ud9>ˮ`L!,.kP# 60mi517KmrwPۉ4 /#0P I.+6ɉyV$C>< 6uFA50l1s5J m:q{<Ÿ/v0|U`.& |OҬ=IW-n4 ¶<[I,vmyA&vOQ?VSڬ5r*N\`B _9z (ԥGyZ| z"$ ĉ PPJ,< ;k]y.8;;Bs} HhFmiM>B=5a%@pX$9g hlaJALewٞ;OccrvxMIJU negQ2h t}:zIX!){8/`'\+)N)NML pJ@k#|1wC*aڑ9+ȢS_p/G .99/- s'LYx%Ŕh4 l}i~VX-BOWspᑎp/吢΁7mH`$?t:]E+O`R[bE_۲\h;dMvMZuWײe\kp9zhJ~%Qt Dq-37ˑWrNޕusWdMj}ǭ(C^\ P)ؐU>:ϦӺfK rG|KE]> 8QMQ{{Lo*ÚP97.48N>8/>w 竔~<֑.B5^AFދ]ļ{$O `6xpmvt\mz^NgΔNwpvp'edE]JِN}#d9,~7oꛇ`~龏^4;}Ie@ pcfE6&I\䎶A=\W6m'+ Ђ;!mɅ  A 90]\Y9qY}LӠBNyLG3N׎sh\R2ᶵL刬[sIEĤ+SJNGڎ-䓘D浺ZZlHM8ذit*]j:Uص| Uj*`<^tX-zןl]bC['SݐA \ӣ\M}fJ9ᚖ0|r#f"r?D:He=P%2PELt.גWb ^ ϗI//K9nW Aat<ݩЧby;hz4>NtdRȐP™mΠu}otavx[@SӻyYd9h |C #U]Jp00 @e^Y+ E =Pw7 4| Ũ.coDW"92MJݠj/5 NYI^ A:gVӼ&}9NFӆ~p BDn̞` ޛγ5G@ꋺN|!x4g@7>4 X<$WPUoƟ/A-Ch2CG%W@Q`&h%#qZ%kdczMN-$^zU*T]j:qxǵ/(X L8M 0 (>" Xfߒ7H!q?=_Q=rwcpɘev ^W(a/z Q4{ F?.SX"s;FȲ#8D*ǡ杜ak,@ɄlLn#ĪNKG1E ¼phO=@R@ (\C-e/`IV@*b}^G}:2.?Ktf ߠ֤jG +C /FpBzq`a&ٽW> 30LF)=)|osӧory>NH5Iy1.UGI 3]48'$Dw4Ok}iݮNě@58tzn~<_hB{#Kc)f馶#_U8"2!k! 鱲j:xf1,΅̪QۢGN9LN4M+%B|aΉ iI#2q|+Jj=ߐY.\9X}sv!M` v=6NN"8iP񽦥-]l$5/j%uzS!6W|QAM[| ߢ)K` xVN{ 1~ Z@UF.I)RZѵۣ->Q]RHw4|5b/$Sz>Hq{sHΟͷ[No ] A4㴹k=:oB|Pd$`J2G ST;ccSZtX](8.Ӎ5qk*?[9:oQyyGNJj?lQH(mz'[spm8ӈLQw.Q72lޭ2!@UC~DRUer;+GFT9;1+t/}+`n{A9r i~I]c.k/$ y7J̌ǵ[NNb|G{>i"ҿƺЬ<]0䖖,mVIAl5zx sZHtTQAEhD9&>]> m/wVp*/Aomݕ7kG^bc]GsFqm+B^tt*{)W2g~WƼ2Yy@, 3j#;[!Ǜ\q&@_.J^L7YuBf5z<\hfVAlNۢkjAbA!5g%gjSlkݭ8h*8{dl+"&?i(9" I.N@\#O3p\K.lҰհd#*;E5N\s.D c ܷ Ph'H{ 0sQ?ʃ}\SGԸ)硔d9űբW%t؜E*i~n+ۂ:N:!WG@y̏)+| ?r9n^C 8}.|3FI!mOϒ%e`e#+8 (rču+B*ًkTC@/QW)ɛ ڗ&zӽl 9v͜+D:+KM$Y^SO.@>$p[?YZt(8 6%Q7e ȹȂ^>-e#HZ{hVE+ܿA4dQ\ MQcs[8﹤fS~oM;̗~JMi6(+8GIrp٬V5:O`%zh}?Lo`t1ݔQd 3}_ʣL@0٪ r6LL' P6K,m( Y?og-kvm -vt^~55Hpא$,EM"W\o`Qx*9J9qZ TAL^5`h/VvUY|SVD8awqNrЉF$1U,tܨސҮ;! A\ +T.R `QBZnpjv D̔ᡔ ^o򌹅̤jQֳ)zA A-;^WmI3/B&q3Rh4;V; ZH6ӭĘA+%߼<\oy1!d~H)y )Y 8Dh3+ y`R ̈́qځwa1 D2Cy -tI-W}{ =hjo wRDI!CTܶCL,Bc2fh򵿑)ȘX¬%ONvtA0=/k嶟L]:x\ _L-$}cZT|>1hHZXA^]4W鼑R\a?am^f1EjS[Bo_3윑`oJa;Q;LMk6ciwX1tC7LN _|RpK$k,K17\̧,ދ:]2Gз XGm hkrHeћo5ܥQmօRuqd Z=ܛ4AF3.>LVTkK>}%OYywWEgWF$pZ =7"OL!55,` g>8p);17=+a$[OvfW(D2E Zbh\r`ͥz@>˪rǠqi))BO?c'pFa>%K\*h"[ւgoN6ED{>q8%e*߉S˦HhTLGĠ!-N/!dJɬբ(1OWD;溑};tg &Uɤ7=$.*`}+L7ہŕkb̘0;#T v*Cl\ ͼ U|^{}{BZUct~tEWoq(j]U>r ~b(_WBl:xQP{Xwd1">RG8'HC'VKߨb9LS Ѓ%L:K'𐋔Vҵ!HRhմ|o7E!u JS^|o.Y~0<-wZ/ YEC|H*Ba+e> owcxj>*L=%cT%_:Abь?@0eޓ9 _"e2?4*}w`0/p촜S & %}`S 'Y!~Q;pz xCztƖhޏ˖G,L Ԗmt_Kf^l aD5)=5Ґ2 v m2E7|V|z$Lh epgJi,qVԍLip>c!AACyoLH[]#6 H<h}\u,BM1#/NnO"gev #Fѧbd3+>ڲqk) "# ZMY^qqV[}$3}|es=[Cvc=TFPIx] ,00˴r>"Dx!u'KǛUAh%x:͟ت[Ni~ oK/75D`ap*8d>*QPï~Tb+*?lZ]PφǓIT[Ҍ=0 ߴetv"^97ˮ{n_sM%-K-/\RwDPڡunRω:lhBolmUYjO c|IȀ51Mv1oZS5'F6-L|PG2Fv - K8t(]ǧQc=@KVvjS$ab҂J1l.t%~~ 37ZwdvԾGB^"蹋C5MrYqO}#ʒ ^f)7)]ˏّ[ŽG*϶j{ãSbP#!qQ\:תVtНXإ>lnKr\j014dbK_qb4-Nj{)UI) c^MTRvh?%5d??fjx6(H\^G <V԰hVPiX̲7ؓy8rD)=MP6k8PFfGZ ;Ga;7k0.IX cP`[ vޤc1 g\'I~yZ})TאWVxܳGW;"Yp fyj,]E.ߵ -);6d?}\D[Wo:IEp=AHl#T(~)#rA4;VOoi}w//+$P's[4>O+Uq$~53ƈ}m2kbvg_J;V'dQ`|HxZ2m( uf8Aph_L])}Gґn&4q{bܜɸ$`ٶ-ZD+{3*0XtԮg,.[4uR=GNt6J5B1u{Fcc]e£5 8Iǭf]rObU1w>@+>$6 Q%ϖp eH|;ASzE) i{~'(boidyϦ{v`reu2#~}cWS܌*2dwT0aŗxegl7tRުnX{:k׭^p_`>(W%O endstream endobj 1251 0 obj << /Length1 1644 /Length2 12179 /Length3 0 /Length 13032 /Filter /FlateDecode >> stream xڭxeTܒ-ww 5w̺ϼ}j%NZMA bfosa`ad(lM\UmyT;do'nh@S++ ftPkj+" ;7-\,s  -(RHN6eW)@d s68L@% 08;MAn@S_=d rv9,\>zbٙڸ?n~`d.ΦN GTeqbiWlg 7ifoWIc41p+ `rv1A; Wgd@pZ;?h> O;8xmrqژ3"~4umC`kVd,:s: f# c3{;OI#$2 "zߩ%]mlm?;d{ k;c[ﷵH!q1hŇ4 <<@Β 2`nlѷvf@'C߿[ ``af7Ldjmvf^ŇdEIRFI.Y5a3dX{:7ٿ{X8 ,#5VvGX`2323|WF#agjo ۙ}޿ NN>WzMVMBR3\js&u{Y BJ {S÷x*^jBx<^weiFz?P|mPvp1 hE{_d۞PQ5(~!`s s$sgRՉ^[p|BtxGctxht.>]v<1߷cdO#7'7.ʅj$ w/EWb- 36"w‹&qr_cY Ħe :eN9WOyS3ybAQRdoh?3t̤5QT5($?E 'o t tUe(3 bX#ohO`Tcv o4~-ZJmBq;MMzö7Z&AKnWwGA\6gÐtX`b7O&5Qz[3z"9w3ww(݄4!yDZE5d`9_Љ5ȋ3Y\{Hp_msp 斱SEh5ĵ8"=4i7̵&#ՄZߡ1'Tdt=URfd_ī8lQmJ C=5Q<0YnD<7_PQE H1#@f8!;*0f~P5gwJ UvlΆv"Wqk}Vt*ƨ}yvU࣊Gz{_vrth>ͥq3~.g?2c!_ ?lqt)!V+Wx;C zI0X ]lEtAK_כ,7 v^Z o}+ϕX\j,3>"h$! 6bu` = F!fU$8Wj@9jx8a>%bюz;lhG}~{b A:ưĎ%) b'q:2IՒAnK7s+׋!ql0G",Uj $=pl8"2^&6/04ѫ$\10͠ }ǭ%$n0QtbD$N3Ϊ_@U3W75Reh͒-kF^5e]H8SBOW &Ѕ{/xБ0WogeQ WWu(c7_S|Aj6CMf] *%C {7iJp*s2rkV q |`jF. ŷ :IcL43^g>,{m1]K$" p1R"_Pә]0+-!`+ eM7(jPm ~o9fpœ`%.H; VW 3#t>Yd<:CXt1:F,I&1P]Ȧ2r.65>l[++4P$J l‰QoP4M1O;,QL8* %F« r'޶Y/F) )S{ g!ֈZwwƄqohJDyM.o!FhPJ ӵ;'XzapT ΋mYʧ2uphNEiYb5Ri@}v):OfZHb?1\x_jATyu@?td? #cdJzuۻ'ٛ.SyԤ3XY{bɥ{Txfx"SoW)U|F5Ja*Ny%j8,Mj& K[)%IfUpGqZ0 &)sHLİBB[E?lcNδD>cfb#7\e;1 -"Q_l垗^?((K>!DN9"',^uP|!qKt9I q qEBJH78ױD?=B4:yu30Eh+`zJܚOOzilcDn.0%'ްdѐSq}Tvj١U<+Ӆ&TU^й`$a7M\+DTwֿ4vFP3ϫC&f?(%3&&Cn Q4sdT% RTEO&|T8!RS NfKr5t,myKlx{yzG?t锖*)Wd_%NX(5ظe.۷֑oŖ!K0LU+V7]9H/6W[  =h _1w6u Ÿ~xi648Yɥm(@M嘱JI1BAWX>  (x_TRdo{]W1<}wRI&ݣK?ېb/jtlð [a&F0瑔!=lGxbݙ}sM{bRb/bE NweI&=t9ŝ̫@IjrM6 LED^yU\|`/~:9=14eҺ~4\KER(!]`j琥Imu3\UvǓbVjac25 Bd"*=wXJPC2fVE "j*j҂;'=k9mb9m ڲcBg];Fh25.7x̠Fd\'}A76%M#W[M܂.qw8CP]3#`}E!DZN TKM_QE%dp,컏U5/'\_fa ݼXd&lGL(P8!P\A.;,;w1|YHK V+'.i{x`Iji+.A+ EfmGFFꋸ (wlD`0L\sGAޞa?s6Nmݲ,TN8-[HY/Q%+(+_[ZvjRco(4J|+ J] =Clf􄍞ӣiV~Y%_W-/:fjk}K2ˢ\ W$u)?u]^X#YKjf ıaKSdؖ5,4rWc@ g'#(ͼ6:vkM-ԕ3TmWl:KSЮAzl7LrH_ͶGYZmi !3 Eq҇Try+ ͧ;k6C]zX Td$~;rW|i)eEf5k(?j.$ڟOZUqaꚙ]ř녠6SZ~ wK F~B5P SM^V<eB[B6GCYB_W(W?=Mq]CimΆs!뼆prT#Đ%/\ڤE&;p.Ɯd1erUƆċ&[Qm#ߙEuaW>z^V)hO{17GOOaCK+?0͐ƃ \)*S hk}VIIn~%dۿ`΁"P еma(`qZ"ǃɛ6WONR4gA#?1f^ [vx8lò0EghNovDa>[E2D.Ry=Z/(g(yz2[/'$G+cͱx5.:`Y4IAPsXl] SC3,˒c XJN8c!5?wa[zw#ۗWn7!VTHX!"VnL1l>ȣ/' n洑fe˥J|?ٺ.=ԣ&v)`cbuD iv>whL63]ި7Jic4궣(dA.\8&H9C|׷g X͋6W;bh҅ ZC2+O.~GWhhg1 l+t!fFkg˕nĘNT\6P.VbxV6hwPֿW|u4raovX }<#>Yhrmxj\3m6Cڢ71TD2fMHY4 H֯jD]P{Ӱ⺏y 5.tl0A{*(V8q~OwSbtMp#}!S.O-BNq @\|hwu uđˢs^`9#|U?@;hىSRك& Fl@Y3DgE"bΘυÌϽzfm.MJ擉pẅ 3&V22^$dՋ)uM=E,Ϗ ~y0#,LFndY-%"_emfX-q_řF.9uՉK+$y^Nww8 Ni˚m5hҦCYl"ۆ/e cC  *+4Hŀw!_۪$v֔`3JPFus FMȁkUMCy4qҪ`W@:?hkWVa3\N t-J*JPAāCHcFZd̠ 1׽-D桔s]8rM"3t׼X5IIjzJ©kHڶ؂(& +*4s.ѻr`yBHv}|yOVC2섈}I$)q'4jR>~Eꪽ!2,.bCALAɹ/By[ d12et.K:-ɣcTpYN sNDyu~l'3>:f8Oӫ&ɠw+(l5HTwaT8#ᲶRq=U}DcOpoJWN%?D H:}eFvpKhE.Tll}cLwƘgՅțs {V(5U>j$oAq<S!|WHFsL>X}8h&G=jmRLX ÊlDtY;Kx<)mMH6"~ [VsJQ;;=;Nv@pZ ܽC9Rol| H5A7%J!U g)!TSGMz5m̧敿ZPI`t%ڻKi^Pkޅ } }OAm↣Z j/K!-MedOlYT?rY l=A2؟&9{5iÁ8{!qiV- iݱSN=2KJH]lrڳVA`QhV/CB5á`S(KЯjWrGSpf8)8o-څ*66 |b(FzN/SiT,Y~w#G{KB~+*q_`m-v 1ա8qQMm35ke%PZ1ҩ9!3zŬ>UHp9 (ɎبIſ}ƻ@fG6Q~mdp;AS¨)\k͢h85Ņzk*h)eӯF"8e̶D Y]ou* jz93ST~\#sKd"p>:8wiQԬJze6Mس X$ Վ񱭟jt>]!;U ީlj@p^WÜA^qk3Â;(2z yC׺꒥ZϝmjchF6Qh$M}. eW;-tM4EMO5_ JOW »`Va9EPBGٛѤ؍"k}- saw(;RsQd>jcRՕu3+  T: 7 sj\MLZn>KvdBo598)\EQoPo7huuԄ)V$LTU4IbެRlƎ;gѧ28KoLLI}}Ʌ35J"c0#uˢ0 ;6}yiX`I0H(rp7Ts*j=D[q1[D^-khi#C[C1G'./{ϡ9e4j[E=4k2@נ9꙼>p"Eoo02,#{;6Ŏ+*BB I#3%9AMB؇+RQOq 3A62ٓjgU -o`ܜ{O-eB %Tjc~WQV;8xղ OAeao|;~b:"jw~liMdõs_'I9k xR#%RQnshN,՚>^D L2,%z䴾+B^Kk_kME">۔wZŶf]5WQ煜/~X;Wq$a,* bvX7qO&r aYBS9_g*'T*Rv<ԑÁU>5Fj/o\ז|[—ijك܉2B-8[j nR߭hq1H 6,bPQtL2=EԸH9h5BtSUөͳ6 7 7RNl}E1gn-Wn7ŠC5Fڰk ZwU]X!9A(2Q9ŰagR?j~^@)9)=^v-t&TPZP=\,,1 ެ^޻VNHul9ÝoM8|a/t 7g9nDuWILv.EhL}Y:EZfO2{"RI>>@1LjAZ+7ߙb m'ж@)ۏ)Bj*x%` *hg5 Kz3Bla޳(#r\p{WZ71)6$%(!]qb}mĄS;x/kcZWk ɐH߻ɷ0ҕ-Eelu05zˇr3g(|" rR2w-\X@2\hi@Z'o;<=*6&K䅫9vrJ~DԨ ְ!YI$ڃ\8' #ʃqt%ÓnG 2$A< b;:jMq(-ե9cX B8]J]e[^X>+v(C˩!cW#L.±z[/i/C{Ǿ+q?Jn5Tվ4oKpƟ!5"8]+{U% ^ 53?`q2u mҬ.,nc=0`R!n5齩]zF43Z;Y G|)\x#"`5DNeFykV{ƻWByfiV7|0`]^!דR,$M(k5]uo0T>$#ƞ/> ?.,zO~$/K)Z#'pRl- glldORm ”\g{a`0n!3rw@,{m}BLy }MJ{j?7X oq`,wi%W.\Uyuj-tFPxns!ۊ;B[AWK98뀂5t)KXLp hz|b9(̦D]#v^_}ύ@4ͷt2F|q (`A aL)ؘec\)p̲?-, g> v]FA*7IcAC[qpϜE~`Z1_y=~s$軶<ۋS_R斍 6\ w#NQMuSxg>2[B=@iWp9jYM}Mr!"u6MמDd;~د[};v ?pSiiYuOٲjRZU_aB;x\n@ )~mݼəZ2w-Y$DQwSJ=~+=eUzR3Kq&ˀ endstream endobj 1253 0 obj << /Length1 1647 /Length2 14902 /Length3 0 /Length 15737 /Filter /FlateDecode >> stream xڭxctݲmly;6:6;ӱmVǶmN:6;w}Ǿ9x񬚫fUY3or6F"6֎t 3+}'+)Z#'qG=KCJ*dohfc-h P520rppllLL 4O@ldickedEvT428,Br2 QeWrNf)3#k#J= _9}q 8Ff_nFFA4[#{+3g^ mfN%e7;![{V_#+?t4s+ 1ihcWIc_4_XFC3[K=_df`fm hF&zF_4_ο?ZmҘWLǯ&f0 vC'bF_=C^+$⿧2 "L"N2zV_ 94zրY5l, 3UrݪFr;&_ 2бl bjd(gh` 0ֳ:ֆFfF_"}_N )XX? #kK+WQ/ߛ徺Q#J/*AAW-#+;eߙ1k-ho `c``|ֿ61 Z? N_= *K`djdhchX=4!:d[\T[eQVD0pb'A?҃aIޝdtELٛAFO] zq9/AegB^A җ9 .&,|`txhw:+K;[]3 j5QPw_ۀ)Mdˡ;S!b@^[H qA^="^&rZ}r=Sڙ^i3*~:⃠|ӑZ\nP(:BGqy[.GbEJPLȖ(/Dg U'ky E+7oulbS h]^͌MUy݇BXY*YA.⳸_Tv?j~IacbO/*CIRI'c2 ik!3)A(hBgނQY~í6G9 VXGɄ Ϫ* %H^nW'O"Jfn =1 t@x$yKT1e5,<[ugD'v}T&ρ2O6V&;0{9ҨGjTV95UH**]pmCuKHoUP#J؈#M۝7EYJ]M`vm0ڪ^jW&1몔DsuW eZM1&joX8;υ3v3mR4-t ynoVO7ܠr˝yZx2Y[OO7$Nǁ.1Cho|S@H1(ϡE!/{xǬ,xnd*ټ>A‘-u#'|hDmܭ*EtͣZ~"Gg0Ú g}Tg ֿ o;3 z[3r 䒛S,ȑ#f :u㶟^h"c"₋ vsJxSdÖ6Mz}jPEcPFo)\qq*D_ YxmeR,rXj5.+)r(ݟq&4 I3'I*Dg@/3;(b:}I~Nf_KF q#8M)w{0 i}-'T8YgWP5ݫ$,5*$'-bK렏`OtN2W%=cCKˉ|8^ry, orؚe }%[Nޗ/Mok\)a)o``0ǔ&ѷq}/~%coFLg4V4?ۯ5) ʭ<]p:0R6'IcbC1fp֕Pw+qL5+Uv/zM_Lujҹۋ lkھ[fG=8×CNxCa-Zˤ7 UUxPݼ;ȹFEfM>X!Tp7\U&AK*Y]pI6^#m10sw{/{|,-49>*&Z,^ D "%; z91*L\>/.:k,ʦut4t3("J3y !ubLX1@2-|NaLXl"m{&Fsy@x!zkEI&P1 *J; ӯJw>mZW:t+g)="[s]>=5(DZ$'|Is&%4d'FH+eǪED8+8yFHuo63[+} S˛->A@I錓n-xض_֍tݿ?B@wSMZWLي!%pm|u(꣪ ՝!%߯G_Y !"Ar浄Pb#_gKa(H_; ? b;'GqS!.f?fWr ]%_{IJP#Q '\)Om@k;XhdnxU!I^*Lr:e BZ;0oɕӈSS@jKw:jN:'S|?RUBNҫ^'zw bgs#CzBJE Mj &6ޡCnCr 'Ye@?thr|VV.Y\ my>&vL>LMTvjlM"&$8=6@?C׌2>- $jKB  . e w 6{=(Kw 隕׳ۮtcUie@`F7]&36(t-bx!Z}:TF.har"[FAWQ0ߦ#sژ1֤{CLU RcnA0R==snfѽG@{a߅lRdݤl0 ]sJ#&NOe2g>$8"vq\ [&I;]T3W΀ B0h6状2+5k]phgDAU~[Hkݸn$Ka&\Z9w+r6Jk?Q rlXsR#*a>9OޫM7!"=Tk~zEL? rafPL(]pn}ȼ(C'ZG=7S&+ d}p}*N?b{PgSr:(L7,WhpNC+|-JϠ6Bz&3_fI+T:zd9ʗ%$!۲b0m'6H%.^igs~Jq ]n_]- Jm 7"4V0U! z:^SRQoV!1Qю=DeaZ'TkK#ÉLF!'S"$L_ kBcQ(atqN3g lHI]cۈI%/(*v2(K͸6JuHF9%K1 _HFJɮp_i_p>oE`5XډY dfaoAźIb$i ji7 ӷûf5࣑ oC I:0l=,{xC@Nr43J]H='ktmTNRH[`PÁ[=yǥao.*T;ct"oHs"<ߴ4tc6 m~?AW5Ӣ <ř]{z'6EFpA*#/c. zsA롊aipJ:@D/n'Id!d]kdӿ"tvp+OJ8.~ҎbmO[D8gekܾx]348Lӑ Om& ärm0}kD'anL1[7@sH\̽tF, lϣvLJF!-@;@KJzp@&?cLu[gyeKn.Nf"S]1;m{ pqUW"t?*E/PQĝm-c-v ~9SD'"<[u1PݏyJHz.]m +8 LZI+.&PL]!a#+9<#RBl*D_M рDu0:O(` ŎX<;;P-V]: Xyxǿە\>Oz7a k.wu>U^@Y)`qYQk={> hq@ ҟZ4}\Ǐp)2 Hź]̃.N4'5\>VZ4PwI9OQ[ug4F 6⨕ !u^=ͧ<|g}(K'Si*œ 1ޡffXwH/S󇘟JnR/@p| ld'A|H'zҵS"@VEA:P}Euf5h-'\C]m1Nl|oͅ9=oNc!pHc?`Quh'zJW,=&Ιy_Scˊ7 'KQhE('y!^b}L)ի %p3êU\^ ܶv&G/ij&V8O >pӨ+gyYjhL. ld;7/*|xvڳ2UMߕY}(hWY2u >k*-3 L :3KH Qs'q=*DA쪟/.󡨟@Ŭ68݁!ȒlfP\}y.L6vDo>d̈=ٳnɋ$a/{v[ 53j'Rb+kX kEM N7Dg{ʸ lwӓ~,n,.q>3iNPY!lfv .^IMe#5VJ`ttoz~Z&d}!d3 8xhvef >B=g~wmqs:- Iz>x9P΅A+%։i Iw6ُk'x2mi \V( ^)h݋eBaCQ<bB8 7E"7 !`S+_@ۭ9 u7WZ Υ Rpʂ% %;ӑČ 1X34+(e} ԫ_J;xŋG?ŐG.Y _'^Ox*! /EmWP睱&[dim(|0%]} 2}X OX9B5MZ0꾝I6qxOf.K 91sD@\m؛5PCe>D[ﶻQ{3;۱ɓg\`| qL yDN=s넛xSJ 6T]NwD%wBk @;g2F?~kEx5}0a@@Р3 M6\+T{Lj)_߁Cl\/M\1K̾6&vq:RMprp3+2KH6^n< BpƈdiȩѤD邁e=˟k9YrC@, $K=5־6SGo'9Vu᳋rِe ʕ@,(?r}jSe`ba+UT?X%^р9C R)+|DpA%lԗ =IAp ΍e= \E^@pv5tWm{I܅~ϖZJģf;cg5A^|߅h0 L:BEko[. a0dчItE 0 =:EF#6V>.]h-@c Skqj*١YLB8ynioO4VƤ}|wFb NTৼgj܂0 4*~ &%0oZ]jayI~gxg5BsgsY)~Z OXDs"ω 5؝NjxpOᮁxe 6=ZOu$[[qSXexL!hRr7yT &ǚj"8Uw YيVY݈̾+t+<0<*l4x؉Qb-Vna?Nɷuv$%֐i{}b,~O/ f۰DTdTb1~ q-WnL*Om:ys"x쭓LFo "ǡZQq'$$h%tf V샖0*6ݦZ>D;TyZzOy3)+N/t), (܊㐞= 5C&T*F)Lp7TBԗԿEyDuO Yc<لÔHc`|Q1vv\r+Ҝɨ줜UPaLNNTbA`eS\Wqt7nRwCA`Cƶ \mL^x_qWE.l?GE oV=Z"ŖE#b֔]{_У-"%{yq7&0Ė6,!/fͺ92ا*e؅J;sU-YCc.mfVCs/=VKPϯ5=3=1UwvܼAW3E/u`$=$erb-לDX0ѨYS=`Mʜ3\|?us _,P[$-P0}XJbiiP_=2i;Q`v"x9Te#2: \Hc[M}~ v /wnIґΧ~To,;Q1yQ>6Se l= ^=d ;|WGd1~u[ gtYb 5l-/+.13;MZqOm7}6X-p֌P'֧3|9%E|'D}& -$:{躉ab'8̊p-g}=[!u atFNXZ kB jb\z*Mxغwջ%ʹ3S6@jv,-" r;n <U puJH2xLBW^DTQ/eۛ˺ݔh.B;w^dƢ?bd˝2[U[GzE,^SZnk˝ZC#H=s5VkgߘІ}ݎ{^aGK'LX a}88nT,$sAb%5{W)\VOpV4v^$L^yJn !ra~UzrǦ^ʕhz8t3MHYo3?A8Ľ瀾*qH|D HSd'sDG,Y!/*Lˣ ]PĆ AQl/XmP-CuPŬG֙ao.&63 m^Kutl$aZ3&TiؚӶ|>kaПWCi[6' d C.*iۺ\WxlEjӓ~=| .E||O CgyB$­`( YVplZV_fW/(9Z v0ד1qd?hfx[&n!ۓuϼ2 ȑ)v*5<:@8%tmF8W6ax YSէ$gI D5j(>{%bV,%EcAM.ԸJ욼V=A]x\&Mfv4Zg5LH++>{^&9\:rr*N0YP眮H0T։DFmyLS!,&ƢA&ȳ!G~C>\fsw[e׉%'xN)B\۫iC]0P9~d)2T{d^d޽>^Pִ$/ qA5_T2:|Of̘ <ݓ!s&t*xsR~T^٧K7ǫd*Ze95~5# y *L+&>حhMg!/tf)|Zlz"VO'Hz5 u鵫RI+]^Z=[nh6yٱ?uV]rz$^u2^t o٩.ABgh3Pj4]Z`rds3e'O1V޺>4&)iB?T0,WډӅ)t[ ?,eelilZ4iäG3g*ۚ2'yPuە{3Oj(ʊƸ7^4*q, Y2*\,E{ &TLL !D-KەϭUY4*%:|՜Up iYPG\JbKtkeb[Z9<k"e`5s>'y"eN'O$wNQیB4_\jq:BZc].d#p.ƻ4pM¼nI%+ĎU !uAc;:Diuarg%<RlYZ ?&.z"k\#/ȼgZ*V&uUp~V-]zn1='o)؋W\XXU钩rD)K~ j4dڹ})Qrx1sX ~Ol&ϲ}DOSS|S)iԡhx~懬iP,NT@}Suʲ:)y!5RQUcr!:J"}ǯGd~U;z ꠺n>k).ʗ?SD"H)$8ٖ)|&y1u z7:2N Y9d9cr!IJ~10/yZMEc@j[Zb9So؎ ;%UP{UnYAX7 L |F[oK~p7/ZpղyT[2N\Ӣ3"yή}[ݾZ[Od)#j}P+P_[bI>t &XW '@W#t©U H%j;ECVZ//֍ N|IF !pm)rJnME#ܔ {?&RKXYX|Tp-^.ŚD`b 㒿1nىAr V ,wMӘ[&<׏q_4KURbWPLB4Z\bbhEIν6 D{?pf9BT׷N$ܬs9z 乣\ӗʰh) ¼׋5\\ce hHàa*#YE!0-4W$j|$x]ԇ|TVƖqW$d/ˇBd^T|kIq q(,Kbpث+ÌXOyiӆޯ mF3𔚎g6aPJ\u 0Wj$pTbq);d6T=6 0߬ل)D0 0,2jlv-hya &ɧv_NIud uP'knDJCCls:`L&aqxl o=~1G鿰- ?9=wP,:@amuKx;7Kr o܂G"{ x{!]~YZ^ $=t:tysǭQN.!/\4i&us S;E= +SK#f (PZ:҉ Zc&@nV8~OMQ,b HJK&Og'cuh3"$Qk)~FRkV!?d&ؤsnjZkiTL}xbڃaPy膱CmlT hy{հi*uoR,) UˇVI!2}$uۘX-E5Y#~g6nv+>H$м]т7I g~ 4l:/(>-PbFU~"ly;NDh0{CqAqvO*Z껌$"p\hӉ={<XǸE6D T&qi'hfݯA6\AN;F~jQ:HhI'QYGcW<#'>sf~vfu5xv%F~6.~{ ei!Iv!5z6e1$"  7&w+-`, 19}+BG+VWe}OBnF l|-cnK}C~0grm;|t' ZlTw|{zO ^N,Z-3-!W}r|7^  ]Z zi \"#I }ghCZLo Nod+Ni{`sfK3=,[gD@4$a9G֥jnvꪐIwr3nAҶUc*݄%)'kxȉek?͟,o.t"N񍄥hl5,Қ< . D@t]j矂@ 3ܣ߸dJ' 1R5 ܕ _V2TYQB^IɥDh{r9 RJForOzk.D/AebO?˝Y\W5Q5m[y ϰ8KM_86%&YOd*ugāߍL(DeSHIwubi7~?K)? r^#JOER /Ib&1ܢ͚zr0^|6i/Q~$}yFt~g҂]Uա1Q$v]Hl>&s(Mc%|86̀k{r\$ \F8XYu!2.`Y).?쒨Rp} ]7s{7Zp *V}߅ C^CTGҝo EَHat#% $Ph(n%@ ]+2=2?x%G* Rf[HQ8E͡#pISD &;~=8 s>˪mi7C~ƒO*qcZRBPH,:q~7$."#Yݤɵ3ٯSo;R; hfS_p ԏ5\Ìu(ǠU?8l!B\jވk endstream endobj 1233 0 obj << /Type /ObjStm /N 100 /First 939 /Length 3962 /Filter /FlateDecode >> stream x[o8=~`[$GvKI^Q[ItԒ )YMIw+gg8CYhƸRg(lIˠ%?[kr]L>5uAkIŤ˛ַhk~*u7Lbf|HIϫ&I] fZ[r, XܑowT_I]6 9f岩ndAܓbYW/%>Ŕ׫|&WeV`բ-׵o4|[470BKڻeYY| L˒|!U. ȃM{=(Οx_0(Q(@PaHF Aup08"K0 c9|%s;? w$;XZ$#fG߾<ف;K OLҝn[xVwc<ر_޾=Z58o8x\OOp*rF-/a۰ ģɫϪ,.mbp=x5,E@cuM1vxg"bëGg~yu-rZp NXz!( ǢcpE]+HobT@KŔ+~L.W#3Kn̵f2L?*::}qH `KU1X(vĎT¯+G_Vw~DF9QgH8yOc>((|Ht]_͆ކ{m7KqT*-/_[GtuPD MkPDfU냏 ,qbO1&]ӧ]Amoxc+UxkÀ_usS>pE ^?y'2aCcs3Jp9Nwnzj}*蓂<>cu v/HPÐo_mAoVTPpy !:L+Sֻ \-fO$7ImfSH 8X]Hݼ~NV׭{NHUϊđKcuwqlZp9-7~]t"`㚷iqXp}7`[MDVg Wloax` 0xCAIymc-Da$ohi =HysʖrDm4CL|ؑtP>jhD57?}svy7۲Qm*O=ƿ+3O_Dy ߅GPY?{؞H.;%nGPOT?}&itsc("y'3"h<$Z@f}F ?.;WaT{ui׀wEfP!m}v!Ow UL ǿ::s 5Wm W\Yi1qeLRSoG]|;azӵ]<+Vm(2:,7e]+qe2RSԠ+ ej>;e2L qTD@"@ qdDJ 82"@r Sȁ1N)@'@Db @#D> "E"qXDO8,"`lRЁ:N`)@'FtMFvFv Eބf E݄f E܄C:$xmvF6Ug2;^e"CQMסWרjPZ+kTXSuu(U5*:T=x5itF4UG2:^E"C QMϡ|WϨxjP:+gT8Su3(U3;Y39^1Cr(9;:z&rzFcTlm->WUab19le~O7myxge{C؛2D ݕߏ\L~&ly8Y%4 լj79㦧Np1?]`aOO^:'NO{x~~vuq~z^^b??^O}yqteg*@%D=wh!DH/HH`S4BF95zv." [0%< 4޾yѳѱp48sV+,WuTVS+դa$gۓn!m}9:]sxXVuCՖІ@rY|w<5ۇ[s)А`ClcKSۦ^E"u5h %S;XKlI4n}2U NP]L]"\/h|(_ ɀn&wI]4 X38IG;@d_4bs9Id6B;qZk EfP< &blykE[,P&1QTE Q9Q.qP4ؠdښ~Gy嬸sˮ1Y1HE,.d~)"ddpK/C67Mj|r@L:]%iXʛbU,zS[t`jj~$* pZ6; 'Kҡi$j$Cָ;ɶݷvK\g1<|D0xtGu|<?A\^: !~ ڤ<@}fbXO5=n Ұ+zsG0;%qO|47'9C endstream endobj 1367 0 obj << /Producer (pdfTeX-1.40.21) /Author()/Title()/Subject()/Creator(LaTeX with hyperref)/Keywords() /CreationDate (D:20210605185745+10'00') /ModDate (D:20210605185745+10'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.21 (TeX Live 2020/Debian) kpathsea version 6.3.2) >> endobj 1275 0 obj << /Type /ObjStm /N 92 /First 956 /Length 4068 /Filter /FlateDecode >> stream xڕ\K#ϯe &Y|#!H8 hzfI~lQ"ك=jbUIҚNu!y2/$:A^)cu|Ro:! ՟nXw\%kB|\eshm9f5tq<Ǽ5ՑyQװojk}ŷSNnmw|Gap컪 ~X0F0e:=#DBWAjS VsTio|lNtRsŸ0R5ƱF:YfwG{$E~ {/Eф\vyӗY~ j1A $-[84&QNafK O-f:x[/C_a8sg2J N/!sSƆwo~_Oquk/GW䑯cNXij6,`/m++&#D2WSd"RT5ߜnT.n OA]p6zt60S(΍hLRz:S4sڶnak28wYoW3|ѵd5);;If7Yqs!n7O (I#XutZ$9$r'<q"UJ;u#ё[XaoaȲhp>.HJMnU΁ jf/Jz82ӱMǒ:qY]p7U[{ndt82_#g +6nF#3{pD!]]n8'k n%U6Vf,8 S^|r_khu}sP mN؋q)8dDkfMfT C pV/ R}V^M]SLw~k/V-0/c@8gLLeS)&3X` IFU+#_VptPa>-{]x׹ Tj8?HLX, 1$DCRe )޲jMkkL"%A9 Tw:. zГz$c@ zlҢ'jsNVi=6 |T'G@ͱhV"dzń >Iq9 fEs[Um9z\@)$㊷@)$< VP&wܫɢiRH:E sH4(6@ _{ (rFo,`JYE5Cub&UdD211‚L  Hz F7[-#^7Cbt^ UkÖϚDLJS1x'xNM&c/tm" r r :Xh )~73qљ3kq R\e=Eg!%ReB!99$1RT\yFq v1oǝi4{\FhLbL~0m"`0W'0 \2p8T76/cwq0 nXL~R V6=ï% nl I !f!H]`Z45(# L~L+L\i`6(WiD€hBM5Dk6cL!ǂg+枂Wњ#,av?Kk_$"~eQn}[?_i- O7ҋVmdLVdLMfT/P PU( YזJFd%#(J N#+sgWq J&Лʁd6md% tgp[-AdNۡ-:mNLKw2[7F^U>sH }>ݻ.p>5$G6nQFј@rx<$qQtam endstream endobj 1368 0 obj << /Type /XRef /Index [0 1369] /Size 1369 /W [1 3 1] /Root 1366 0 R /Info 1367 0 R /ID [<8F37821DD86819126A8A150F9732B7A7> <8F37821DD86819126A8A150F9732B7A7>] /Length 3169 /Filter /FlateDecode >> stream x%I&Y:<<=s' _} #Cey)% e(UҸ7Tr1.!@}XJ ITz^8w%{dmj dheϕnooYyް Sg~q[]Ż0MMqoa8OT:|e"#pǰ.4`33psf"]zy˅db``/{Y˼^B/1rBXW|ZџZˣ^u^o/Ize{jݟm^|߿n_gݿg8U[ <T?y&&rI$<Ҵ5cX 1Mթ:FWF fV0dwRښ{W#8 {RuYA8 7>Gp"U/= 硆 p.e @n܆;nD>bŽ 3tн3rzIoDW 1H su*j15JٰS;0Xa (ңeVMX$z^ k|Q,VD0 `7Zo ĺlLƺt2:o`6:j3pXw6X(j,]hd 62Q,F/|d^27X3Ws>hmTct 47fh8lfw[4l^aFQmجy PtC}שGҰJ*0@Ch~!U/>w 퇉r4Ar6$: eq 20 ?~  (=Pz@JR|ؕx9Prǽ8 ={ @!FPCb4YOS :ĦClԒfF rz チaPX``X-$ 3 aX?+G+dka2kx[ _S0 r= 'Ruܔf=̇X `U6F{amJE[`+lvn#/`_JK!:0q8p:޳pj\4pvnmw!!v!ӏ!vO!!v/>o51w.6҆[}/KLLL\G~\D șșșșy9P:S:S:S:K^ >>~ɧ2<ggggg+/>&>>>>>>>>>>>>>>>> 3333339,@r;hk z 0&:6s`.̃2'udI XLGzXmX;*VZXalۇz3X[TY+SQbmX= kz8 A0N+jGRsZק@)πJ]yp4Y;߭/ Ҿ MbmV[շPkk֨vX;{j'r}J Bm9X;_+P8{N&(Lk'|5mg-~K6QR~K6&zhsՋS|;zYߋ+hy~oR~K-[귱y~귱P-8&~K6*R~K6~oGր84j3q H5~k4 4}a҇q5OtJ8WR_4*~fNzz?榩ռ4_4q M/^\b5_>gb-fb3l13rWWƷ8GEeEzZ7 o(QxF$xb,# G(Q8pD# G(Q8pD# G(ƥb\q)Q8pD# (AQzPԃE=(AQzPԃE=(AQzPԃE=(AQzPԃE=(AQzPԃ—iw&~g Eq endstream endobj startxref 224002 %%EOF statnet.common/src/0000755000176200001440000000000014056636212014017 5ustar liggesusersstatnet.common/src/logspace_utils.c0000644000176200001440000001254413701734650017207 0ustar liggesusers/* File src/logspace_utils.c in package statnet.common, 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 2007-2019 Statnet Commons */ #include #include #include /* * Compute log sum x given log(x) values logx * * log (sum_i exp (logx[i]) ) = * log (e^M * sum_i e^(logx[i] - M) ) = * M + log( sum_i e^(logx[i] - M) * * without causing overflows or throwing much accuracy. * * Based on logspace_sum in pgamma.c in R; unlike that implementation, * it does not use the long double type, sacrificing precision for a * speed gain. */ double log_sum_exp(const double *logx, int n){ if(n == 1) return logx[0]; if(n == 2) return logspace_add(logx[0], logx[1]); // else (n >= 3) : int i; // Mx := max_i log(x_i) double Mx = logx[0]; for(i = 1; i < n; i++) if(Mx < logx[i]) Mx = logx[i]; double s = 0.; for(i = 0; i < n; i++) s += exp(logx[i] - Mx); return Mx + log(s); } SEXP log_sum_exp_wrapper(SEXP logx, SEXP long_double){ long_double = PROTECT(coerceVector(long_double, LGLSXP)); logx = PROTECT(coerceVector(logx, REALSXP)); int n = length(logx); SEXP out = PROTECT(allocVector(REALSXP, 1)); if(LOGICAL(long_double)[0]) REAL(out)[0] = logspace_sum(REAL(logx), n); else REAL(out)[0] = log_sum_exp(REAL(logx), n); UNPROTECT(3); return(out); } /* * Compute a weighted mean of x given log-weights lw * * log (sum_i exp (logx[i]) ) = * log (e^M * sum_i e^(logx[i] - M) ) = * M + log( sum_i e^(logx[i] - M) * * without causing overflows or throwing much accuracy. * Based on logspace_sum in pgamma.c in R. */ double logspace_wmean (const double *x, const double* logw, int n){ if(n == 1) return x[0]; // else (n >= 2) : int i; // Mw := max_i log(w_i) double Mw = logw[0]; for(i = 1; i < n; i++) if(Mw < logw[i]) Mw = logw[i]; double sw = 0., sxw = 0.; for(i = 0; i < n; i++){ double w = exp(logw[i] - Mw); sw += w; sxw += w*x[i]; } return (double) sxw/sw; } SEXP logspace_wmean_wrapper(SEXP x, SEXP logw){ x = PROTECT(coerceVector(x, REALSXP)); logw = PROTECT(coerceVector(logw, REALSXP)); int n = length(x); if(n != length(logw)) error("Lengths of value and log-weight vectors differ."); SEXP out = PROTECT(allocVector(REALSXP, 1)); REAL(out)[0] = logspace_wmean(REAL(x), REAL(logw), n); UNPROTECT(3); return(out); } /* Matrix version of logspace_wmean */ void logspace_wmeans (const double *xm, const double* logw, int n, int p, double *out){ if(n == 1){ memcpy(out, xm, p*sizeof(double)); return; } // else (n >= 2) : int i; // Mw := max_i log(w_i) double Mw = logw[0]; for(i = 1; i < n; i++) if(Mw < logw[i]) Mw = logw[i]; memset(out, 0, p*sizeof(double)); double sw = 0.; for(i = 0; i < n; i++){ double w = exp(logw[i] - Mw); sw += w; for(unsigned int j = 0; j < p; j++) out[j] += w*xm[i + j*n]; } for(unsigned int j = 0; j < p; j++) out[j] /= sw; } SEXP logspace_wmeans_wrapper(SEXP xm, SEXP logw){ SEXP xdim = PROTECT(getAttrib(xm, R_DimSymbol)); int n = INTEGER(xdim)[0], p = INTEGER(xdim)[1]; xm = PROTECT(coerceVector(xm, REALSXP)); logw = PROTECT(coerceVector(logw, REALSXP)); if(n != length(logw)) error("Number of rows in the value matrix differs from the length of the log-weights vector."); SEXP out = PROTECT(allocVector(REALSXP, p)); logspace_wmeans(REAL(xm), REAL(logw), n, p, REAL(out)); UNPROTECT(4); return(out); } SEXP sweep2m(SEXP xm, SEXP stats){ SEXP xdim = PROTECT(getAttrib(xm, R_DimSymbol)); int n = INTEGER(xdim)[0], p = INTEGER(xdim)[1]; SEXP out = PROTECT(allocMatrix(REALSXP, n, p)); xm = PROTECT(coerceVector(xm, REALSXP)); stats = PROTECT(coerceVector(stats, REALSXP)); /* if(p != length(stats)) error("Number of columns in the value matrix differs from the length of the STATS vector."); */ unsigned int pos = 0; for(unsigned int i=0; i= 2) : int i; // Mw := max_i log(w_i) double Mw = logw[0]; for(i = 1; i < n; i++) if(Mw < logw[i]) Mw = logw[i]; memset(out, 0, p*p*sizeof(double)); double sw = 0.; for(i = 0; i < n; i++){ double w = exp(logw[i] - Mw); sw += w; for(unsigned int j = 0; j < p; j++) for(unsigned int k = 0; k <= j; k++) out[j + k*p] += w*xm[i + j*n]*xm[i + k*n]; } for(unsigned int j = 0; j < p; j++) for(unsigned int k = 0; k <= j; k++){ out[j + k*p] /= sw; out[k + j*p] = out[j + k*p]; } } SEXP logspace_wmean2_wrapper(SEXP xm, SEXP logw){ SEXP xdim = PROTECT(getAttrib(xm, R_DimSymbol)); int n = INTEGER(xdim)[0], p = INTEGER(xdim)[1]; xm = PROTECT(coerceVector(xm, REALSXP)); logw = PROTECT(coerceVector(logw, REALSXP)); if(n != length(logw)) error("Number of rows in the value matrix differs from the length of the log-weights vector."); SEXP out = PROTECT(allocMatrix(REALSXP, p, p)); logspace_wmean2(REAL(xm), REAL(logw), n, p, REAL(out)); UNPROTECT(4); return(out); } statnet.common/src/init.c0000644000176200001440000000251513711220501015114 0ustar liggesusers/* File src/init.c in package statnet.common, 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 2007-2019 Statnet Commons */ #include #include #include // for NULL #include /* FIXME: Check these declarations against the C/Fortran source code. */ /* .Call calls */ extern SEXP log_sum_exp_wrapper(SEXP, SEXP); extern SEXP logspace_wmean_wrapper(SEXP, SEXP); extern SEXP logspace_wmean2_wrapper(SEXP, SEXP); extern SEXP logspace_wmeans_wrapper(SEXP, SEXP); extern SEXP sweep2m(SEXP, SEXP); static const R_CallMethodDef CallEntries[] = { {"log_sum_exp_wrapper", (DL_FUNC) &log_sum_exp_wrapper, 2}, {"logspace_wmean_wrapper", (DL_FUNC) &logspace_wmean_wrapper, 2}, {"logspace_wmean2_wrapper", (DL_FUNC) &logspace_wmean2_wrapper, 2}, {"logspace_wmeans_wrapper", (DL_FUNC) &logspace_wmeans_wrapper, 2}, {"sweep2m", (DL_FUNC) &sweep2m, 2}, {NULL, NULL, 0} }; void R_init_statnet_common(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } statnet.common/NEWS0000644000176200001440000002045514056622141013731 0ustar liggesusersstatnet.common 4.5.0 ==================== New utilities ------------- - `ergm`'s term locator functions (`locate_function()` and `locate_prefixed_function()`) have been moved from `ergm`. - A new function, `default_options()`, a wrapper around `options()` that drops options already set. - A new function, `as.control.list()` generic and methods which take an R list and call an appropriate `control.*()` function on it. - `check.control.class()` now first runs the control argument through `as.control.list()` and overwrites, so `control=` arguments to many functions can be plain lists. - A new function, `simplify_simple()`, which takes a list and returns an atomic vector if the elements of the list are atomic and of length 1, with particular handling for `NULL` and empty (0-length) elements. - A new function, `snctrl()` (StatNet ConTRoL), designed so that argument completion will complete all available control functions. Looking up its help (`?snctrl`) produces a dynamic list of all control parameters and their packages and control functions that is updated as packages are loaded and unloaded. - A new function, `handle.controls()`, that performs the most normal functions in a `control.*()` function. - Two trivial helper functions, `base_env()` and `empty_env()`, to replace an object's environment with `baseenv()` and `emptyenv()`, respectively. - A new function, `fixed.pval()` that wraps `base::format.pval()` with better default arguments. - A reimplementation of `attr()` is exported, which disables partial matching by default. Enhancements to existing utilities ================================== - `statnetStartupMessage()` now first looks for a `comment=(affil=...)` for the contributor's affiliation, before using e-mail. - Improved output formatting for `.Deprecate_once()`. - `append_rhs.formula()` now accepts NULL as the first argument, in which case it creates a new formula, and takes an additonal argument `env=`, which is used as this new formula's environment. Miscellaneous changes ===================== - `rle` utilities are no longer reexported. - `statnet.common` no longer depends on `purrr`. - `statnetStartupMessage()` has been simplified. statnet.common 4.4.0 ==================== `rle` utilities have been moved to a separate package, `rle` ------------------------------------------------------------ - Major methods are reexported, for now. New utilities ------------- - `split()` methods for matrices and arrays, to split them along a margin. - `trim_env()`, a generic that will replace an environment (possibly attached to another object) with a sub-environment containing only objects whose names are specified. - A `diff()` method for control lists and a `print()` method for the resulting differences. - `deInf()`, to replace `.deinf()` in package `ergm`. - A `compress()` generic, a `compress()` method for RLEs, and a `doNotCompress` argument to `rep.rle()`. Both `compact.rle()` and the `doNotCompact` argument to `rep.rle()` are now deprecated. Enhancements to existing utilities ---------------------------------- - Various optimizations have been made to RLEs. - `nonsimp_update.formula()` now handles both one and two sided formulas; it also now copies all names except `...` when `from.new = TRUE`. Bug fixes --------- - `str.rle()` now works despite the overridden `length()` method. statnet.common 4.3.0 ==================== New utilities ------------- - `EVL()`, a family of functions like `NVL()`, that treat any object of length 0 as `NULL`. - `once()`, a `purrr`-style adverb that wraps a function to only evaluate the first time it's called with a given configuration of arguments. - `persistEval()` and `persistEvalQ()` to retry evaluating a given expression a specified number of times. Bug fixes --------- - In `forkTimeout()`, don't collect a process twice. Thanks to Tomas Kalibera for suggesting the fix. statnet.common 4.2.0 ==================== New utilities ------------- - `.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`. - `forkTimeout()` evaluates an R expression with a hard time limit (except on Windows) by forking a process. Unlike `setTimeLimit()`, it enforces the limit even on native code. - `ult()` is a convenience function that extracts or replaces elements of a list indexed from the end. Miscellaneous ------------- - `statnet.common` now depends on R \>= 3.5 due to what appears to be a method dispatching bug in earlier versions. - The package no longer Enhances `coda`. statnet.common 4.1.4 ==================== New utilities ------------- - `despace()` removes whitespace from a string. - Pseudo-methods `colMeans.mcmc.list()`, `sweep.mcmc.list()`, and `lapply.mcmc.list()` (migrated from the `ergm` package). - `filter_rhs.formula()` selectively deletes terms in on the RHS of a formula. - `eval_lhs.formula()` extracts the LHS of the formula and evaluates it in the specified environment. - `NVL2()` and `NVL3()` for flexible substitution of null values. - `message_print()` formats its arguments as if for `print()` or `show()` methods, but then prints to stderr like `message()`. Enhancements to existing utilities ---------------------------------- - `paste.and()` now takes an additional `con=` argument, allowing a conjunction other than "and" to be used. - `ERRVL()` now uses lazy evaluation and lets the user dot-substitute the previous argument's try-error into the next argument. Bug fixes --------- - Printing for control lists now works for function arguments. - A number of improvements to `rle` methods. Miscellaneous ------------- - A number of functions have been renamed for consistency: - `term.list.formula()` → `list_rhs.formula()` - `append.rhs.formula()` → `append_rhs.formula()` - `nonsimp.update.formula()` → `nonsimp_update.formula()` - Citation utilities have been deprecated, since CRAN's structure makes them unusable. statnet.common 4.0.0 ==================== - The package now uses `Roxygen` for documentation. - `term.list.formula()` output format has been changed, since support of attributes on symbols is being deprecated. - A library of methods has been added for the base `rle` class, implementing concatenation, compaction, and a number of binary operations. - `all_same()` has been moved from ergm and renamed to `all_identical()`. - A new assignment method `NVL()<-` overwrites a variable if its value is NULL. - A set of classes and functions for manipulating and efficiently performing calculations on dense matrices or vectors with weighted rows or elements (possibly on the log scale) has been added. - New control parameter helper function, control.remap() has been added. Autodetection of function names by `set.control.class()` and `check.control.class()` has been deprecated and now results in a warning. - Improvements to the compressed data frame code, including an order() generic. - Miscellaneous robustifications added. - Native routine registration has been added. statnet.common 3.3.0 ==================== - `append.rhs.formula()`, `vectors.namesmatch()`, `term.list.formula()`, and `ergm.update.formula()` (renamed to `nosimp.update.formula()`) moved from `ergm`. - Skye Bender-deMoll has been added as a contributor. statnet.common 3.2.3 ==================== - `ERRVL()` moved from `ergm`. - Some `NAMESPACE` and other fixes to pass CRAN checks. statnet.common 3.2.2 ==================== - control class improvements and bug fixes. statnet.common 3.1.1 ==================== - Updated e-mail address - Some improvements to opttest. statnet.common 3.1.0 ==================== - Initial release, incorporating the control class framework (`set.control.class()`, `check.control.class()`, `print.control.list()`); startup message framework; `NVL()`; `sort.data.frame()`; `compress.data.frame()`; `paste.and()`; citation utilities framework; and `opttest()` framework. statnet.common/R/0000755000176200001440000000000014056636063013435 5ustar liggesusersstatnet.common/R/logspace.utils.R0000644000176200001440000001251214056622257016515 0ustar liggesusers# File R/logspace.utils.R in package statnet.common, 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 2007-2021 Statnet Commons ####################################################################### #' Utilities for performing calculations on logarithmic scale. #' #' A small suite of functions to compute sums, means, and weighted means on #' logarithmic scale, minimizing loss of precision. #' #' #' @aliases log_mean_exp log_sum_exp lweighted.mean lweighted.var #' @param logx Numeric vector of \eqn{\log(x)}, the natural logarithms of the #' values to be summed or averaged. #' #' @param x Numeric vector of \eqn{x}, the (raw) values to be summed #' or averaged. For \code{lweighted.mean} and \code{lweighted.var}, #' \code{x} may also be a matrix, in which case the weighted mean #' will be computed for each column of \code{x} and the weighted #' variance-covariance matrix of the columns of \code{x} will be #' returned, respectively. #' #' @param logw Numeric vector of \eqn{\log(w)}, the natural logarithms of the #' weights. #' @param use_ldouble Whether to use \code{long double} precision in the #' calculation. If \code{TRUE}, 's C built-in \code{logspace_sum()} is used. If #' \code{FALSE}, the package's own implementation based on it is used, using #' \code{double} precision, which is (on most systems) several times faster, at #' the cost of precision. #' @return The functions return the equivalents of the following R expressions, #' but faster and with less loss of precision: \describe{ #' \item{`log_sum_exp(logx)`}{\code{log(sum(exp(logx)))}} #' \item{`log_mean_exp(logx)`}{\code{log(mean(exp(logx)))}} #' \item{`lweighted.mean(x,logw)`}{\code{sum(x*exp(logw))/sum(exp(logw))} for \code{x} scalar and #' \code{colSums(x*exp(logw))/sum(exp(logw))} for \code{x} matrix} #' \item{`lweighted.var(x,logw)`}{\code{crossprod(x*exp(logw/2))/sum(exp(logw))}} } #' @author Pavel N. Krivitsky #' @keywords arith #' @examples #' #' logx <- rnorm(1000) #' stopifnot(all.equal(log(sum(exp(logx))), log_sum_exp(logx))) #' stopifnot(all.equal(log(mean(exp(logx))), log_mean_exp(logx))) #' #' x <- rnorm(1000) #' 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(m <- colSums(x*exp(logw))/sum(exp(logw)), #' lweighted.mean(x, logw), check.attributes=FALSE)) #' stopifnot(all.equal(crossprod(t(t(x)-m)*exp(logw/2))/sum(exp(logw)), #' lweighted.var(x, logw), check.attributes=FALSE)) #' @name logspace.utils #' @useDynLib statnet.common #' @export log_sum_exp <- function(logx, use_ldouble=FALSE){ if(length(logx)==0) -Inf else .Call("log_sum_exp_wrapper", logx, use_ldouble, PACKAGE="statnet.common") } #' @rdname logspace.utils #' @export log_mean_exp <- function(logx, use_ldouble=FALSE){ if(length(logx)==0) NaN else .Call("log_sum_exp_wrapper", logx, use_ldouble, PACKAGE="statnet.common") - log(length(logx)) } #' @rdname logspace.utils #' @export lweighted.mean <- function(x, logw){ d <- dim(x) if(is.null(d)){ # Vector if(length(x)==0) NaN else if(length(x)!=length(logw)) stop("x and logw must have the same length") else .Call("logspace_wmean_wrapper", x, logw, PACKAGE="statnet.common") }else if(length(d)>2){ stop("Arrays of 3 or more dimensions are not supported at this time.") }else{ # Matrix if(d[1L]==0) rep(NaN, d[2L]) else if(d[1L]!=length(logw)) stop("logw must have the same length as the number of rows in x") else .Call("logspace_wmeans_wrapper", x, logw, PACKAGE="statnet.common") } } #' @rdname logspace.utils #' @export lweighted.var <- function(x, logw){ E <- lweighted.mean(x, logw) if(is.null(dim(x))){ if(length(x)<2) return(NA) x <- x - E lweighted.mean(x*x, logw) }else{ if(nrow(x)<2) return(matrix(NA, 1, ncol(x))) .Call("logspace_wmean2_wrapper", sweep_cols.matrix(x, E), logw, PACKAGE="statnet.common") } } #' Suptract a elements of a vector from respective columns of a matrix #' #' An optimized function equivalent to \code{sweep(x, 2, STATS)} for a matrix #' \code{x}. #' #' #' @param x a numeric matrix; #' @param STATS a numeric vector whose length equals to the number of columns #' of \code{x}. #' @param disable_checks if \code{TRUE}, do not check that \code{x} is a #' numeric matrix and its number of columns matches the length of \code{STATS}; #' set in production code for a significant speed-up. #' @return A matrix of the same attributes as \code{x}. #' @examples #' #' x <- matrix(runif(1000), ncol=4) #' s <- 1:4 #' #' stopifnot(all.equal(sweep_cols.matrix(x, s), sweep(x, 2, s))) #' #' @export sweep_cols.matrix <- function(x, STATS, disable_checks=FALSE){ if(!disable_checks) if(!is.matrix(x) || mode(x)!="numeric" || ncol(x)!=length(STATS)) stop("Argument ",sQuote("x")," must be a numeric matrix variable (not an expression that evaluates to a numeric matrix).") o <- .Call("sweep2m", x, STATS, PACKAGE="statnet.common") attributes(o) <- attributes(x) o } statnet.common/R/statnet.common-deprecated.R0000644000176200001440000000000014015667307020615 0ustar liggesusersstatnet.common/R/locator.R0000644000176200001440000001230114056622257015220 0ustar liggesusers# File R/locator.R in package statnet.common, 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 2007-2021 Statnet Commons ####################################################################### #' A simple dictionary to cache recent InitFunction lookups. #' #' @param name function name. #' @param env the environment name for the function; if `NULL`, look #' up in cache, otherwise insert or overwrite. #' #' @return A character string giving the name of the environment #' containing the function, or `NULL` if not in cache. #' @noRd locate_function_cache <- local({ cache <- list() watchlist <- character(0) # Packages being watched for unloading. pkglist <- character(0) # Current list of packages. # Reset the cache and update the list of watched packages. reset <- function(...){ pkglist <<- .packages() new <- setdiff(pkglist, watchlist) for(pkg in new){ setHook(packageEvent(pkg, "detach"), reset) setHook(packageEvent(pkg, "onUnload"), reset) } watchlist <<- c(watchlist, new) cache <<- list() } # Check if new namespaces have been added. checknew <- function(){ if(!setequal(.packages(), pkglist)) reset() } function(name, env=NULL){ checknew() if(is.null(env)){ cache[[name]] }else{ cache[[name]] <<- env } } }) #' Locate a function with a given name and return it and its environment. #' #' 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. #' #' @name locate_function NULL #' @describeIn locate_function a low-level function returning the #' reference to the function named `name`, or `NULL` if not found. #' #' @param name a character string giving the function's name. #' @param env an [`environment`] where it should search first. #' @param ... additional arguments to the warning and error warning messages. See Details. #' #' @return 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. #' #' @details 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. #' #' @examples #' #' # Locate a random function in base. #' locate_function(".row_names_info") #' #' @export locate_function <- function(name, env = globalenv(), ...){ if(is.call(name)) name <- name[[1]] name <- as.character(name) # Try the given environment... if(!is.null(obj<-get0(name, mode='function', envir=env))){ env <- environment(obj) envname <- environmentName(env) # Check that environment name is not blank or globalenv(), and # that the detected environment actually contains the object. if(! NVL(envname,"") %in% c("", "R_GlobalEnv") && exists(name, mode='function', envir=env, inherits=FALSE)) return(call(":::",as.name(envname),as.name(name))) else return(as.name(name)) } # Try the cache... envname <- locate_function_cache(name) if(!is.null(envname)) return(call(":::",as.name(envname),as.name(name))) # Use getAnywhere()... #' @importFrom utils getAnywhere m <- getAnywhere(name) if(length(m$objs)){ ## Prioritise visible over not: if(any(m$visible)){ m <- lapply(m[-1], "[", m$visible) } if(length(m$objs)>1) warning("Name ",name," matched by multiple objects; using the first one on the list.", ...) envname <- environmentName(environment(m$objs[[1]])) locate_function_cache(name, envname) return(call(":::",as.name(envname),as.name(name))) } NULL } #' @describeIn locate_function a helper function that searches for a #' function of the form `prefix.name` and produces an informative #' error message if not found. #' #' @param prefix a character string giving the prefix, so the #' searched-for function is `prefix.name`. #' @param errname a character string; if given, if the function is not #' found an error is raised, with `errname` prepended to the error #' message. #' @param call. a logical, whether the call #' (`locate_prefixed_function`) should be a part of the error #' message; defaults to `FALSE` (which is different from [stop()]'s #' default). #' #' @export locate_prefixed_function <- function(name, prefix, errname, env = globalenv(), ..., call.=FALSE){ if(is.call(name)) name <- name[[1]] name <- as.character(name) fname <- paste(prefix,name,sep=".") f <- locate_function(fname, env, ...) if(is.null(f) && !is.null(errname)) stop(errname,' ', sQuote(name), " function ", sQuote(fname), " not found.", ..., call.=call.) else f } statnet.common/R/zzz.R0000644000176200001440000000076714015667307014427 0ustar liggesusers# File R/zzz.R in package statnet.common, 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 2007-2020 Statnet Commons ####################################################################### .onUnload <- function(libpath){ library.dynam.unload("statnet.common",libpath) } statnet.common/R/deprecation_utils.R0000644000176200001440000000552314056633145017300 0ustar liggesusers# File R/deprecation_utils.R in package statnet.common, 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 2007-2021 Statnet Commons ####################################################################### #' @name deprecation-utilities #' @rdname deprecation-utilities #' @title Utilities to help with deprecating functions. #' NULL #' @rdname deprecation-utilities #' #' @description `.Deprecate_once` calls [.Deprecated()], passing all its arguments #' through, but only the first time it's called. #' #' @param ... arguments passed to [.Deprecated()]. #' #' @examples #' \dontrun{ #' options(warn=1) # Print warning immediately after the call. #' f <- function(){ #' .Deprecate_once("new_f") #' } #' f() # Deprecation warning #' f() # No deprecation warning #' } #' @importFrom utils modifyList #' @export .Deprecate_once <- local({ warned <- c() function(...){ me <- sys.call(-1) myname <- format(me[[1L]]) if(! myname%in%warned){ do.call(".Deprecated", modifyList(list(old=myname),list(...))) warned <<- c(warned, myname) } } }) #' @rdname deprecation-utilities #' @description `.Deprecate_method` calls #' [.Deprecated()], but only if a method has been called by name, #' i.e., \code{\var{METHOD}.\var{CLASS}}. Like `.Deprecate_once` it #' only issues a warning the first time. #' #' @param generic,class strings giving the generic function name and #' class name of the function to be deprecated. #' #' @examples #' \dontrun{ #' 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. #' } #' @export .Deprecate_method <- local({ warned <- c() function(generic, class){ fullname <- paste(generic,class,sep=".") if(! fullname%in%warned){ me <- sys.call(-1)[[1L]] if(length(me)>1 && me[[1L]]=="::") me <- me[[3L]] parent <- sys.call(-2)[[1L]] if(length(parent)>1 && parent[[1L]]=="::") parent <- parent[[3L]] if(me==fullname && NVL(parent,"")!=generic){ do.call(".Deprecated", list(msg=paste0("You appear to be calling ", fullname,"() directly. ", fullname,"() is a method, and will not be exported in a future version of ", sQuote("ergm"),". Use ", generic, "() instead, or getS3method() if absolutely necessary."), old=fullname)) warned <<- c(warned, fullname) } } } }) statnet.common/R/formula.utilities.R0000644000176200001440000003475114042235671017244 0ustar liggesusers# File R/formula.utilities.R in package statnet.common, 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 2007-2020 Statnet Commons ####################################################################### ################################################################### ## This file has utilities whose primary purpose is examining or ## ## manipulating ERGM formulas. ## ################################################################### #' @title Functions for Querying, Validating and Extracting from Formulas #' #' A suite of utilities for handling model formulas of the style used in Statnet packages. #' #' @name formula.utilities NULL #' @describeIn formula.utilities #' #' \code{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 #' \code{keep.onesided==FALSE} (the default). #' #' @param object formula object to be updated or evaluated #' @param newterms list of terms (names) to append to the formula, or #' a formula whose RHS terms will be used; either may have a "sign" #' attribute vector of the same length as the list, giving the sign #' of each term (`+1` or `-1`). #' @param 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 #' @param env an environment for the new formula, if `object` is `NULL` #' @param \dots Additional arguments. Currently unused. #' @return \code{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. #' @examples #' #' ## 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))) #' #' \dontshow{ #' stopifnot(f1 == (y~x+z1+z2)) #' stopifnot(f2 == (y~z)) #' stopifnot(f3 == (y+x~-z)) #' stopifnot(f4 == (~y+z)) #' stopifnot(f5 == (y~x+z1-z2)) #' stopifnot(f6 == (~z)) #' stopifnot(f7 == (~-z)) #' } #' #' @export append_rhs.formula <- function(object = NULL, newterms, keep.onesided = FALSE, env = environment(object)){ if(is.null(object)) keep.onesided <- TRUE if(inherits(newterms,"formula")) newterms <- list_rhs.formula(newterms) for(i in seq_along(newterms)){ newterm <- newterms[[i]] termsign <- if(NVL(attr(newterms, "sign")[i], +1)>0) "+" else "-" if(length(object)==0){ if(termsign == "-") newterm <- call(termsign, newterm) object <- as.formula(call("~", newterm), env = env) }else if(length(object)==3) object[[3L]]<-call(termsign,object[[3L]],newterm) else if(keep.onesided) object[[2L]]<-call(termsign,object[[2L]],newterm) else object[[3L]]<- if(termsign=="+") newterm else call(termsign,newterm) } object } #' @describeIn formula.utilities #' #' \code{append.rhs.formula} has been renamed to \code{append_rhs.formula}. #' @export append.rhs.formula<-function(object,newterms,keep.onesided=FALSE){ .Deprecate_once("append_rhs.formula") append_rhs.formula(object,newterms,keep.onesided) } #' @describeIn formula.utilities #' #' \code{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. #' #' #' @examples #' ## 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")) #' #' #' \dontshow{ #' stopifnot(f1 == ~-b+c) #' stopifnot(f2 == ~b-c) #' stopifnot(f3 == ~a+c) #' stopifnot(f4 == ~-a-c) #' stopifnot(f5 == ~a-b) #' stopifnot(f6 == ~-a+b) #' stopifnot(f7 == ~-a+b) #' } #' #' @param f a function whose first argument is the term and whose #' additional arguments are forwarded from `...` that returns either #' `TRUE` or `FALSE`, for whether that term should be kept. #' @export filter_rhs.formula <- function(object, f, ...){ rhs <- ult(object) SnD <- function(x){ if(!f(x, ...)) return(NULL) if(is(x, "call")){ op <- x[[1L]] if(! as.character(op)%in%c("+","-")) return(x) else if(length(x)==2){ arg <- SnD(x[[2L]]) if(is.null(arg)) return(NULL) else return(call(as.character(op), arg)) }else if(length(x)==3){ arg1 <- SnD(x[[2L]]) arg2 <- SnD(x[[3L]]) if(is.null(arg2)) return(arg1) else if(is.null(arg1)){ if(as.character(op)=="+") return(arg2) else return(call(as.character(op), arg2)) } else return(call(as.character(op), arg1, arg2)) }else stop("Unsupported type of formula passed.") }else return(x) } rhs <- SnD(rhs) ult(object) <- rhs object } #' @describeIn formula.utilities #' #' \code{nonsimp_update.formula} is a reimplementation of #' \code{\link{update.formula}} that does not simplify. Note that the #' resulting formula's environment is set as follows. If #' \code{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). #' #' @param new new formula to be used in updating #' @param from.new logical or character vector of variable names. controls how #' environment of formula gets updated. #' @return #' \code{nonsimp_update.formula} each return an #' updated formula object #' @importFrom stats as.formula #' @export nonsimp_update.formula<-function (object, new, ..., from.new=FALSE){ old.lhs <- if(length(object)==2) NULL else object[[2L]] old.rhs <- if(length(object)==2) object[[2L]] else object[[3L]] new.lhs <- if(length(new)==2) NULL else new[[2L]] new.rhs <- if(length(new)==2) new[[2L]] else new[[3L]] sub.dot <- function(c, dot){ if(is.name(c) && c==".") dot # If it's a dot, return substitute. else if(is.call(c)) as.call(c(list(c[[1L]]), lapply(c[-1], sub.dot, dot))) # If it's a call, construct a call consisting of the call and each of the arguments with the substitution performed, recursively. else c # If it's anything else, just return it. } deparen<- function(c, ops = c("+","*")){ if(is.call(c)){ if(as.character(c[[1L]]) %in% ops){ op <- as.character(c[[1L]]) if(length(c)==2 && is.call(c[[2L]]) && c[[2L]][[1L]]==op) return(deparen(c[[2L]], ops)) else if(length(c)==3 && is.call(c[[3L]]) && c[[3L]][[1L]]==op){ if(length(c[[3L]])==3) return(call(op, call(op, deparen(c[[2L]],ops), deparen(c[[3L]][[2L]],ops)), deparen(c[[3L]][[3L]],ops))) else return(call(op, deparen(c[[2L]],ops), deparen(c[[3L]][[2L]],ops))) } } return(as.call(c(list(c[[1L]]), lapply(c[-1], deparen, ops)))) # If it's a non-reducible call, construct a call consisting of the call and each of the arguments with the substitution performed, recursively. }else return(c) } # This is using some argument alchemy to handle the situation in # which object is one-sided but new is two sided with a dot in the # LHS. quote(expr=) creates a missing argument object that gets # substituted in place of a dot. The next statement then checks if # the resulting LHS *is* a missing object (as it is when the # arguments are ~a and .~.) removes the LHS if it is. out <- if(length(new)==2) call("~", deparen(sub.dot(new.rhs, old.rhs))) else if(length(object)==2) call("~", deparen(sub.dot(new.lhs, quote(expr=))), deparen(sub.dot(new.rhs, old.rhs))) else call("~", deparen(sub.dot(new.lhs, old.lhs)), deparen(sub.dot(new.rhs, old.rhs))) if(identical(out[[2]], quote(expr=))) out <- out[-2] # a new sub-environment for the formula, containing both # the variables from the old formula and the new. if(identical(from.new,FALSE)){ # The new formula will use the environment of the original formula (the default). e <- environment(object) }else{ # Create a sub-environment also containing variables from environment of new. e <- new.env(parent=environment(object)) if(identical(from.new,TRUE)) from.new <- setdiff(ls(pos=environment(new), all.names=TRUE), "...") # If TRUE, copy all of them but the dots (dangerous!). for(name in from.new) assign(name, get(name, pos=environment(new)), pos=e) } as.formula(out, env = e) } #' @describeIn formula.utilities #' #' \code{nonsimp.update.formula} has been renamed to \code{nonsimp_update.formula}. #' @export nonsimp.update.formula<-function (object, new, ..., from.new=FALSE){ .Deprecate_once("nonsimp_update.formula") nonsimp_update.formula(object, new, ..., from.new=from.new) } .recurse_summation <- function(x, sign){ if(length(x)==1) {out <- list(x); attr(out,"sign")<-sign; out} else if(length(x)==2 && x[[1L]]=="+") .recurse_summation(x[[2L]],sign) else if(length(x)==2 && x[[1L]]=="-") .recurse_summation(x[[2L]],-sign) else if(length(x)==3 && x[[1L]]=="+") { l1 <- .recurse_summation(x[[2L]],sign) l2 <- .recurse_summation(x[[3L]],sign) out <- c(l1, l2) attr(out,"sign") <- c(attr(l1,"sign"), attr(l2,"sign")) out } else if(length(x)==3 && x[[1L]]=="-"){ l1 <- .recurse_summation(x[[2L]],sign) l2 <- .recurse_summation(x[[3L]],-sign) out <- c(l1, l2) attr(out,"sign") <- c(attr(l1,"sign"), attr(l2,"sign")) out } else if(x[[1L]]=="(") .recurse_summation(x[[2L]], sign) else {out <- list(x); attr(out,"sign")<-sign; out} } #' @describeIn formula.utilities #' #' \code{term.list.formula} is an older version of \code{list_rhs.formula} that required the RHS call, rather than the formula itself. #' #' @param rhs,sign Arguments to the deprecated `term.list.formula`. #' #' @export term.list.formula<-function(rhs, sign=+1){ .Deprecate_once("list_rhs.formula") .recurse_summation(rhs, sign) } #' @describeIn formula.utilities #' #' \code{list_summands.call}, given an unevaluated call or expression #' containing the sum of one or more terms, returns a list of the #' terms being summed, handling \code{+} and \code{-} operators and #' parentheses, and keeping track of whether a term has a plus or a #' minus sign. #' #' @return \code{list_summands.call} returns a list of unevaluated calls, with an additional numerical vector attribute \code{"sign"} with of the same length, giving the corresponding term's sign as \code{+1} or \code{-1}. #' #' @export list_summands.call<-function(object){ .recurse_summation(object, sign=+1) } #' @describeIn formula.utilities #' #' \code{list_rhs.formula} returns a list containing terms in a given #' formula, handling \code{+} and \code{-} operators and parentheses, and #' keeping track of whether a term has a plus or a minus sign. #' #' @return #' \code{list_rhs.formula} returns a list of formula terms, with an additional numerical vector attribute \code{"sign"} with of the same length, giving the corresponding term's sign as \code{+1} or \code{-1}. #' @export list_rhs.formula<-function(object){ if (!is(object, "formula")) stop("Invalid formula of class ",sQuote(class(object)),".") .recurse_summation(ult(object), sign=+1) } #' @describeIn formula.utilities #' #' \code{eval_lhs.formula} extracts the LHS of a formula, evaluates it in the formula's environment, and returns the result. #' #' @return #' \code{eval_lhs.formula} an object of whatever type the LHS evaluates to. #' @examples #' ## eval_lhs.formula #' #' (result <- eval_lhs.formula((2+2)~1)) #' #' stopifnot(identical(result,4)) #' @export eval_lhs.formula <- function(object){ if (!is(object, "formula")) stop("Invalid formula of class ",sQuote(class(object)),".") if(length(object)<3) stop("Formula given is one-sided.") eval(object[[2L]],envir=environment(object)) } #' Make a copy of an environment with just the selected objects. #' #' @param object An [`environment`] or an object with #' [`environment()`] and `environment()<-` methods. #' @param ... Additional arguments, passed on to lower-level methods. #' #' @param 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. #' #' @return An object of the same type as `object`, with updated environment. #' @export trim_env <- function(object, keep=NULL, ...){ UseMethod("trim_env") } #' @describeIn trim_env A method for environment objects. #' @export trim_env.environment <- function(object, keep=NULL, ...){ # NB: The parent should be baseenv(), not emptyenv(), because :: and # ::: are defined in baseenv(), so PKG:::NAME calls won't work. e <- new.env(parent=baseenv()) for(vn in keep){ try(assign(vn, get(vn, envir=object), envir=e), silent=TRUE) } e } #' @describeIn trim_env Default method, for objects such as [`formula`] and [`function`] that have [`environment()`] and `environment()<-` methods. #' @export trim_env.default <- function(object, keep=NULL, ...){ environment(object) <- trim_env(environment(object), keep, ...) object } #' Replace an object's environment with a simple, static environment. #' #' @param object An object with the `environment()<-` method. #' #' @return An object of the same type as `object`, with updated environment. #' #' @examples #' f <- y~x #' environment(f) # GlobalEnv #' #' environment(empty_env(f)) # EmptyEnv #' #' \dontshow{ #' stopifnot(identical(environment(empty_env(f)), emptyenv())) #' } #' @export empty_env <- function(object){ environment(object) <- emptyenv() object } #' @rdname empty_env #' @examples #' #' environment(base_env(f)) # base package environment #' #' \dontshow{ #' stopifnot(identical(environment(base_env(f)), baseenv())) #' } #' @export base_env <- function(object){ environment(object) <- baseenv() object } statnet.common/R/startup.utilities.R0000644000176200001440000000725714056636063017307 0ustar liggesusers# File R/startup.utilities.R in package statnet.common, 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 2007-2020 Statnet Commons ####################################################################### ## .who.loaded.me <- function(){ ## top.call <- sys.calls()[[1L]] # Grab the top-level call. ## top.fn <- as.character(top.call[[1L]]) ## if(length(top.fn)!=1 || !(top.fn %in% c("library","require"))) return(NULL) ## top.call <- match.call(get(as.character(top.call[[1L]]),baseenv(),mode="function"),top.call) # Expand the arguments. ## top.call <- as.list(top.call) # Turn the call into a list. ## top.pkg <- top.call$package ## if(!NVL(top.call$character.only,FALSE)) ## as.character(top.pkg) ## else top.pkg ## } #' Construct a "standard" startup message to be printed when the package is #' loaded. #' #' This function uses information returned by [packageDescription()] #' to construct a standard package startup message according to the #' policy of the Statnet Project. #' #' @param pkgname Name of the package whose information is used. #' @param friends,nofriends No longer used. #' #' #' @return 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.) #' #' @note Earlier versions of this function printed a more expansive #' message. This may change again as the Statnet Project policy #' evolves. #' @seealso [packageDescription()], [packageStartupMessage()] #' @keywords utilities #' @examples #' #' \dontrun{ #' .onAttach <- function(lib, pkg){ #' sm <- statnetStartupMessage("ergm") #' if(!is.null(sm)) packageStartupMessage(sm) #' } #' } #' @export statnetStartupMessage <- function(pkgname, friends = c(), nofriends = c()) { desc <- utils::packageDescription(pkgname) paste0("\n", sQuote(desc$Package), " ", desc$Version, " (", desc$Date, "), part of the Statnet Project\n", "* ", sQuote(paste0("news(package=\"", desc$Package, "\")")), " for changes since last version\n", "* ", sQuote(paste0("citation(\"", desc$Package, "\")"))," for citation information\n", "* ", sQuote("https://statnet.org"), " for help, support, and other information\n") } #' Set [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. #' #' @param ... see [options()]: either a list of `name=value` pairs or #' a single unnamed argument giving a named list of options to set. #' #' @return The return value is same as that of [options()] (omitting #' options already set). #' #' @examples #' 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) #' @export default_options <- function(...){ x <- list(...) if(is.null(names(x))){ if(length(x)==1) x <- x[[1]] else stop("invalid argument") } if(all(names(x)=="")) stop("list argument has no valid names") if(any(names(x)=="")) stop("invalid argument") toset <- setdiff(names(x), names(options())) do.call(options, x[toset]) } statnet.common/R/cite.utilities.R0000644000176200001440000001016614056622257016522 0ustar liggesusers# File R/cite.utilities.R in package statnet.common, 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 2007-2021 Statnet Commons ####################################################################### # ---- BEGIN STATNET CITATION FUNCTIONS ---- #' \code{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. #' #' #' @param pkg Name of the package whose citation is being generated. #' @return For \code{statnet.cite.head} and \code{statnet.cite.foot}, an object #' of type \code{citationHeader} and \code{citationFooter}, respectively, #' understood by the \code{\link{citation}} function, with package name #' substituted into the template. #' #' For \code{statnet.cite.pkg}, an object of class \code{\link{bibentry}} #' containing a 'software manual' citation for the package constructed from the #' current version and author information in the \code{DESCRIPTION} and a #' template. #' @seealso citation, citHeader, citFooter, bibentry #' @keywords utilities #' @name statnet.cite #' @examples #' #' \dontrun{ #' statnet.cite.head("statnet.common") #' #' statnet.cite.pkg("statnet.common") #' #' statnet.cite.foot("statnet.common") #' } NULL # A header function for ensuring that all the statnet packages provide consistent messaging #' @rdname statnet.cite #' @export statnet.cite.head <- function(pkg){ .Deprecated("No longer usable.") utils::citHeader( paste("`",pkg,"` is part of the Statnet suite of packages. ", "If you are using the `",pkg,"` package for research that will be published, ", "we request that you acknowledge this by citing the following.\n", 'For BibTeX format, use toBibtex(citation("',pkg,'")).', sep="") ) } # A footer function for ensuring that all the statnet packages provide consistent messaging #' @rdname statnet.cite #' @export statnet.cite.foot <- function(pkg){ .Deprecated("No longer usable.") # the 'meta' variable should be provided by R's CITATION processing script # instead of using packageDescription(). But if this code is called in another context # use packageDescription() to assign meta if(!exists("meta") || is.null(meta)){ meta <- utils::packageDescription(pkg) } utils::citFooter("We have invested a lot of time and effort in creating the", "Statnet suite of packages for use by other researchers.", "Please cite it in all papers where it is used. The package",pkg," is made distributed under the terms of the license:",meta$License ) } # generates a consistent bibentry citation for the software manual of the package #' @rdname statnet.cite #' @export statnet.cite.pkg <- function(pkg){ .Deprecated("No longer usable.") # the 'meta' variable should be provided by R's CITATION processing script # instead of using packageDescription(). But if this code is called in another context # use packageDescription() to assign meta if(!exists("meta") || is.null(meta)){ meta <- utils::packageDescription(pkg) } projhomepage <- "http://www.statnet.org" # compute the list of authors auts <- eval(parse(text=meta$`Authors@R`)) auts <- auts[sapply(auts, function(aut) "aut" %in% aut$role)] # create a citation entry for a "software manual" for this version of the software # it will be appended with any specific articles defineded inthe package citation file utils::bibentry("Manual", author = auts, title = paste(meta$Package,": ", meta$Title, sep=""), organization = paste("The Statnet Project (\\url{", projhomepage, "})",sep=""), year = substr(meta$Date,1,4), note = paste("R package version ", meta$Version, sep=""), url = paste("CRAN.R-project.org/package=",meta$Package,sep="") ) } # ---- END STATNET CITATION FUNCTIONS ---- statnet.common/R/misc.utilities.R0000644000176200001440000007105514053620112016516 0ustar liggesusers# File R/misc.utilities.R in package statnet.common, 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 2007-2020 Statnet Commons ####################################################################### #' reorder vector v into order determined by matching the names of its elements #' to a vector of names #' #' A helper function to reorder vector \code{v} (if named) into order specified #' by matching its names to the argument \code{names} #' #' does some checking of appropriateness of arguments, and reorders v by #' matching its names to character vector \code{names} #' #' @param v a vector (or list) with named elements, to be reorderd #' @param names a character vector of element names, corresponding to names of #' \code{v}, specificying desired orering of \code{v} #' @param errname optional, name to be reported in any error messages. default #' to \code{deparse(substitute(v))} #' @return returns \code{v}, with elements reordered #' @note earlier versions of this function did not order as advertiased #' @examples #' #' test<-list(c=1,b=2,a=3) #' vector.namesmatch(test,names=c('a','c','b')) #' @export vector.namesmatch<-function(v,names,errname=NULL){ if(is.null(errname)) errname <- deparse(substitute(v)) if (is.null(names(v))){ if(length(v) == length(names)){ names(v) <- names }else stop('Length of "', errname, '" is ', length(v), " but should be ", length(names),".") }else{ if(length(v) == length(names) && length(unique(names(v)))==length(v) && length(unique(names))==length(names) && all(sort(names(v)) == sort(names))){ namesmatch <- match(names, names(v)) v <- v[namesmatch] }else stop('Name missmatch in "', errname,'". Specify by position.') } v } #' "Compress" a data frame. #' #' \code{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. #' \code{decompress_rows.compressed_rows_df} reconstructs the original data frame. #' #' #' @param x For \code{compress_rows.data.frame} a \code{\link{data.frame}} to be #' compressed. For \code{decompress_rows.compress_rows_df} a \code{\link{list}} as #' returned by \code{compress_rows.data.frame}. #' @param ... Additional arguments, currently unused. #' @return For \code{compress_rows.data.frame}, a \code{\link{list}} with three #' elements: \item{rows }{Unique rows of \code{x}} \item{frequencies }{A vector #' of the same length as the number or rows, giving the number of times the #' corresponding row is repeated } \item{ordering}{A vector such that if #' \code{c} is the compressed data frame, \code{c$rows[c$ordering,,drop=FALSE]} #' equals the original data frame, except for row names} \item{rownames}{Row #' names of \code{x}} #' #' For \code{decompress_rows.compressed_rows_df}, the original data frame. #' @seealso \code{\link{data.frame}} #' @keywords manip #' @examples #' #' (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)) #' #' @export compress_rows.data.frame<-function(x, ...){ r <- rownames(x) o <- order.data.frame(x) x <- x[o, , drop=FALSE] firsts<-which(!duplicated(x)) freqs<-diff(c(firsts,nrow(x)+1)) x<-x[firsts, , drop=FALSE] structure(x, frequencies=freqs, ordering=order(o), rownames=r, class=c("compressed_rows_df", class(x))) # Note that x[order(x)][order(order(x))]==x. } #' @rdname compress_rows.data.frame #' @export decompress_rows.compressed_rows_df<-function(x, ...){ r <- x rn <- attr(x, "rownames") f <- attr(x, "frequencies") o <- attr(x, "ordering") out <- r[rep.int(seq_along(f), f),, drop=FALSE][o,, drop=FALSE] rownames(out) <- rn out } #' @rdname sort.data.frame #' @export order <- function(..., na.last = TRUE, decreasing = FALSE) UseMethod("order") #' @rdname sort.data.frame #' @export order.default <- function(..., na.last = TRUE, decreasing = FALSE) base::order(..., na.last=na.last, decreasing=decreasing) #' @rdname sort.data.frame #' @export order.data.frame<-function(..., na.last = TRUE, decreasing=FALSE){ x <- list(...)[[1L]] do.call(base::order,c(unname(x), na.last=na.last, decreasing=decreasing)) } #' @rdname sort.data.frame #' @export order.matrix<-function(..., na.last = TRUE, decreasing=FALSE){ x <- list(...)[[1L]] do.call(base::order,c(lapply(seq_len(ncol(x)), function(i) x[,i]), na.last=na.last, decreasing=decreasing)) } #' Implement the \code{\link{sort}} and \code{\link{order}} methods for #' \code{\link{data.frame}} and \code{\link{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.. #' #' #' @param x A \code{\link{data.frame}} to sort. #' @param \dots Ignored for \code{sort}. For \code{order}, first argument is #' the data frame to be ordered. (This is needed for compatibility with #' \code{\link[base]{order}}.) #' @param decreasing Whether to sort in decreasing order. #' @param na.last See \code{\link[base]{order}} documentation. #' @return For \code{sort}, a data frame, sorted lexicographically. For #' \code{order}, a permutation \code{I} (of a vector \code{1:nrow(x)}) such #' that \code{x[I,,drop=FALSE]} equals \code{x} ordered lexicographically. #' @seealso \code{\link{data.frame}}, \code{\link{sort}}, \code{\link{order}}, #' \code{\link{matrix}} #' @keywords manip #' @examples #' #' data(iris) #' #' head(iris) #' #' head(order(iris)) #' #' head(sort(iris)) #' #' stopifnot(identical(sort(iris),iris[order(iris),])) #' @export sort.data.frame<-function(x, decreasing=FALSE, ...){ x[order(x,decreasing=decreasing),,drop=FALSE] } #' Convenience functions for handling [`NULL`] objects. #' #' #' @param \dots,test expressions to be tested. #' #' @name NVL #' #' @note 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. #' #' @seealso [`NULL`], \code{\link[base]{is.null}}, \code{\link[base]{if}} #' @keywords utilities #' NULL #' @describeIn NVL #' #' Inspired by SQL function \code{NVL}, returns the first argument #' that is not \code{NULL}, or \code{NULL} if all arguments are #' `NULL`. #' #' @examples #' 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 #' @export NVL <- function(...){ for(e in eval(substitute(alist(...)))){ # Lazy evaluate. (See http://adv-r.had.co.nz/Computing-on-the-language.html .) x <- eval(e, parent.frame()) if(!is.null(x)) break } x } #' @describeIn NVL #' #' 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)`. #' #' @param notnull expression to be returned if `test` is not `NULL`. #' @param null expression to be returned if `test` is `NULL`. #' #' @examples #' #' NVL2(a, "not null!", "null!") # "null!" #' NVL2(b, "not null!", "null!") # "not null!" #' @export NVL2 <- function(test, notnull, null = NULL){ if(is.null(test)) null else notnull } #' @describeIn NVL #' #' Inspired by Oracle SQL `NVL2` function and `magittr` \code{\%>\%} #' operator, behaves as `NVL2` but `.`s in the second argument are #' substituted with the first argument. #' #' @examples #' #' NVL3(a, "not null!", "null!") # "null!" #' NVL3(b, .+1, "null!") # 2 #' @export NVL3 <- function(test, notnull, null = NULL){ if(is.null(test)) null else{ e <- substitute(notnull) eval(do.call(substitute, list(e, list(.=test))), parent.frame()) } } #' @describeIn NVL #' #' As `NVL`, but for any objects of length 0 (*E*mpty) rather than just `NULL`. Note that if no non-zero-length arguments are given, `NULL` is returned. #' #' @examples #' #' NVL(NULL*2, 1) # numeric(0) is not NULL #' EVL(NULL*2, 1) # 1 #' #' @export EVL <- function(...){ o <- NULL for(e in eval(substitute(alist(...)))){ # Lazy evaluate. (See http://adv-r.had.co.nz/Computing-on-the-language.html .) x <- eval(e, parent.frame()) if(length(x)){ o <- x; break } } o } #' @describeIn NVL #' #' As `NVL2`, but for any objects of length 0 (*E*mpty) rather than just `NULL`. #' #' @export EVL2 <- function(test, notnull, null = NULL){ if(length(test)) notnull else null } #' @describeIn NVL #' #' As `NVL3`, but for any objects of length 0 (*E*mpty) rather than just `NULL`. #' #' @export EVL3 <- function(test, notnull, null = NULL){ if(length(test)==0) null else{ e <- substitute(notnull) eval(do.call(substitute, list(e, list(.=test))), parent.frame()) } } #' @describeIn NVL #' #' 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. #' #' @param x an object to be overwritten if [`NULL`]. #' @param value new value for `x`. #' #' @examples #' #' NVL(a) <- 2 #' a # 2 #' NVL(b) <- 2 #' b # still 1 #' @export `NVL<-` <- function(x, value){ if(is.null(x)) value else x } #' @describeIn NVL #' #' As assignment to `NVL`, but for any objects of length 0 (*E*mpty) rather than just `NULL`. #' #' @export `EVL<-` <- function(x, value){ if(length(x)) x else value } #' Return the first argument passed (out of any number) that is not a #' \code{try-error} (result of \code{\link[base]{try}} encountering an error. #' #' This function is inspired by \code{\link{NVL}}, and simply returns the first #' argument that is not a \code{try-error}, raising an error if all arguments #' are \code{try-error}s. #' #' #' @param \dots Expressions to be tested; usually outputs of #' \code{\link[base]{try}}. #' @return The first argument that is not a \code{try-error}. Stops #' with an error if all are. #' @note 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. #' #' @seealso \code{\link[base]{try}}, \code{\link[base]{inherits}} #' @keywords utilities #' @examples #' #' print(ERRVL(1,2,3)) # 1 #' print(ERRVL(try(solve(0)),2,3)) # 2 #' print(ERRVL(1, stop("Error!"))) # No error #' #' \dontrun{ #' # 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: ", .))) #' } #' @export ERRVL <- function(...){ x <- NULL for(e in eval(substitute(alist(...)))){ # Lazy evaluate. (See http://adv-r.had.co.nz/Computing-on-the-language.html .) x <- eval(if(inherits(x, "try-error")) do.call(substitute, list(e, list(.=x))) else e, parent.frame()) if(!inherits(x, "try-error")) return(x) } stop("No non-error expressions passed.") } #' Optionally test code depending on environment variable. #' #' A convenience wrapper to run code based on whether an environment variable #' is defined. #' #' #' @param expr An expression to be evaluated only if \code{testvar} is set to a #' non-empty value. #' @param 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. #' @param testvar Environment variable name. If set to one of the #' \code{yesvals}, \code{expr} is run. Otherwise, an optional message is #' printed. #' @param yesvals A character vector of strings considered affirmative values #' for \code{testvar}. #' @param lowercase Whether to convert the value of \code{testvar} to lower #' case before comparing it to \code{yesvals}. #' @keywords utilities environment debugging #' @export opttest <- function(expr, testname=NULL, testvar="ENABLE_statnet_TESTS", yesvals=c("y","yes","t","true","1"), lowercase=TRUE){ testval <- Sys.getenv(testvar) if(lowercase) testval <- tolower(testval) if(testval %in% yesvals) eval.parent(expr) else if(!is.null(testname)) message(testname," test(s) skipped. Set ",testvar," environment variable to run.") } #' Test if all items in a vector or a list are identical. #' #' @param x a vector or a list #' #' @return `TRUE` if all elements of `x` are identical to each other. #' #' @seealso [`identical`] #' #' @examples #' #' stopifnot(!all_identical(1:3)) #' #' stopifnot(all_identical(list("a", "a", "a"))) #' @export all_identical <- function(x){ if(length(x)==0) return(TRUE) v0 <- x[[1L]] for(v in x[-1]) if(!identical(v0,v)) return(FALSE) return(TRUE) } #' Construct a logical vector with `TRUE` in specified positions. #' #' This function is basically an inverse of [`which`]. #' #' @param which a numeric vector of indices to set to `TRUE`. #' @param n total length of the output vector. #' #' @return A logical vector of length `n` whose elements listed in #' `which` are set to `TRUE`, and whose other elements are set to #' `FALSE`. #' #' @examples #' #' x <- as.logical(rbinom(10,1,0.5)) #' stopifnot(all(x == unwhich(which(x), 10))) #' @export unwhich <- function(which, n){ o <- logical(n) if(length(which)) o[which] <- TRUE o } #' Evaluate an \R expression with a hard time limit by forking a process #' #' This function uses #' #ifndef windows #' [parallel::mcparallel()], #' #endif #' #ifdef windows #' `parallel::mcparallel()`, #' #endif #' so the time limit is not #' enforced on Windows. However, unlike functions using [setTimeLimit()], the time #' limit is enforced even on native code. #' #' @param expr expression to be evaluated. #' @param timeout number of seconds to wait for the expression to #' evaluate. #' @param unsupported a character vector of length 1 specifying how to #' handle a platform that does not support #' #ifndef windows #' [parallel::mcparallel()], #' #endif #' #ifdef windows #' `parallel::mcparallel()`, #' #endif #' \describe{ #' #' \item{`"warning"` or `"message"`}{Issue a warning or a message, #' respectively, then evaluate the expression without the time limit #' enforced.} #' #' \item{`"error"`}{Stop with an error.} #' #' \item{`"silent"`}{Evaluate the expression without the time limit #' enforced, without any notice.} #' #' } Partial matching is used. #' @param onTimeout Value to be returned on time-out. #' #' @return Result of evaluating `expr` if completed, `onTimeout` #' otherwise. #' #' @note `onTimeout` can itself be an expression, so it is, for #' example, possible to stop with an error by passing #' `onTimeout=stop()`. #' #' @note Note that this function is not completely transparent: #' side-effects may behave in unexpected ways. In particular, RNG #' state will not be updated. #' #' @examples #' #' forkTimeout({Sys.sleep(1); TRUE}, 2) # TRUE #' forkTimeout({Sys.sleep(1); TRUE}, 0.5) # NULL (except on Windows) #' @export forkTimeout <- function(expr, timeout, unsupported = c("warning","error","message","silent"), onTimeout = NULL){ loadNamespace("parallel") loadNamespace("tools") env <- parent.frame() if(!exists("mcparallel", where=asNamespace("parallel"), mode="function")){ # fork() is not available on the system. unsupported <- match.arg(unsupported) warnmsg <- "Your platform (probably Windows) does not have fork() capabilities. Time limit will not be enforced." errmsg <- "Your platform (probably Windows) does not have fork() capabilities." switch(unsupported, message = message(warnmsg), warning = warning(warnmsg), error = stop(errmsg)) out <- eval(expr, env) }else{ # fork() is available on the system. ## TODO: The suppressWarnings() are working around a bug in ## current parallel package. They should not be necessary after ## the next R release. child <- parallel::mcparallel(eval(expr, env), mc.interactive=NA) out <- suppressWarnings(parallel::mccollect(child, wait=FALSE, timeout=timeout)) if(is.null(out)){ # Timed out with no result: kill. tools::pskill(child$pid) out <- onTimeout suppressWarnings(parallel::mccollect(child)) # Clean up. }else{ out <- out[[1L]] } } out } #' Extract or replace the *ult*imate (last) element of a vector or a list, or an element counting from the end. #' #' @param x a vector or a list. #' @param i index from the end of the list to extract or replace (where 1 is the last element, 2 is the penultimate element, etc.). #' #' @return An element of `x`. #' #' @examples #' x <- 1:5 #' (last <- ult(x)) #' (penultimate <- ult(x, 2)) # 2nd last. #' #' \dontshow{ #' stopifnot(last==5) #' stopifnot(penultimate==4) #' } #' #' @export ult <- function(x, i=1L){ x[[length(x)-i+1L]] } #' @rdname ult #' #' @param value Replacement value for the `i`th element from the end. #' #' @note 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`. #' #' @examples #' (ult(x) <- 6) #' (ult(x, 2) <- 7) # 2nd last. #' x #' #' \dontshow{ #' stopifnot(all(x == c(1:3, 7L, 6L))) #' } #' #' @export `ult<-` <- function(x, i=1L, value){ x[[length(x)-i+1L]] <- value x } #' Evaluate a function once for a given input. #' #' 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. #' #' @param f A function to modify. #' @param 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. #' @param max_entries The number of distinct configurations to #' remember. If not `Inf`, *earliest-inserted* configurations will #' be removed from the database when capacity is exceeded. (This #' exact behavior may change in the future.) #' #' @details 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. #' #' @note Because the function needs to test whether a particular #' configuration of arguments have already been used, do not rely on #' lazy evaluation behaviour. #' #' @examples #' 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. #' #' @export once <- function(f, expire_after=Inf, max_entries=Inf){ local({ prev <- list() prev.time <- c() function(...){ # If using expire_after, expire old entries. if(is.finite(expire_after)){ expired <- Sys.time() - prev.time > expire_after prev <<- prev[!expired] prev.time <<- prev.time[!expired] } sig <- list(...) if(! list(sig)%in%prev){ prev <<- c(prev, list(sig)) prev.time <<- c(prev.time, Sys.time()) if(length(prev) > max_entries){ prev <<- prev[-1] prev.time <<- prev.time[-1] } f(...) } } }) } #' Evaluate an expression, restarting on error #' #' 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. #' #' @param expr an expression to be retried; note the difference #' between [eval()] and [evalq()]. #' @param retries number of retries to make; defaults to #' `"eval.retries"` option, or 5. #' @param 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 #' `expr`, but its errors are not handled. #' @param envir,enclos see [eval()]. #' @param verbose Whether to output retries. #' #' @note If `expr` returns a `"try-error"` object (returned by #' [try()]), it will be treated as an error. This behavior may #' change in the future. #' #' @return Results of evaluating `expr`, including side-effects such #' as variable assignments, if successful in `retries` retries. #' #' @examples #' 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"))) #' @export persistEval <- function(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){ for(attempt in seq_len(retries)){ out <- try(eval(expr, envir=envir, enclos=enclos), silent=TRUE) #' @importFrom methods is if(!is(out, "try-error")) return(out) else{ if(!missing(beforeRetry)) eval(beforeRetry, envir=envir, enclos=enclos) if(verbose) message("Retrying: retry ", attempt, ".") } } out <- eval(expr, envir=envir, enclos=enclos) } #' @rdname persistEval #' @export persistEvalQ <- function(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 <- substitute(expr) beforeRetry <- substitute(beforeRetry) envir <- force(envir) enclos <- force(enclos) persistEval(expr=expr, retries=retries, beforeRetry=beforeRetry, envir=envir, enclos=enclos, verbose=verbose) } #' Truncate values of high magnitude in a vector. #' #' @param x a numeric or integer vector. #' @param replace a number or a string `"maxint"` or `"intmax"`. #' #' @return 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. #' #' @export deInf <- function(x, replace=1/.Machine$double.eps){ if(tolower(replace) %in% c("maxint","intmax")) replace <- .Machine$integer.max ifelse(is.nan(x) | abs(x) length(d)) stop(sQuote("margin"), " must be between 1 and the dimensionality of ", sQuote("x"), ".") args <- c(list(x), rep(TRUE, length(d)), list(drop=FALSE)) ind_call <- function(ind){ args[[margin+1L]] <- ind do.call(`[`, args) } lapply(split(x = seq_len(dim(x)[margin]), f = f, drop = drop, ...), ind_call) } #' @rdname split.array #' @export split.matrix <- split.array #' Convert a list to an atomic vector if it consists solely of atomic elements of length 1. #' #' 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`]. #' #' @param x an R [`list`] to be simplified. #' @param toNA a character string indicating whether `NULL` entries #' (if `"null"`) or 0-length entries including `NULL` (if `"empty"`) #' should be replaced with `NA`s before attempting conversion; #' specifying `keep` or `FALSE` leaves them alone (typically #' preventing conversion). #' @param empty a character string indicating how empty lists should #' be handled: either `"keep"`, in which case they are unchanged or #' `"unlist"`, in which cases they are unlisted (typically to #' `NULL`). #' @param ... additional arguments passed to [unlist()]. #' #' @return an atomic vector or a list of the same length as `x`. #' @examples #' #' (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. #' #' @export simplify_simple <- function(x, toNA = c("null","empty","keep"), empty = c("keep", "unlist"), ...){ if(isFALSE(toNA)) toNA <- "keep" toNA <- match.arg(toNA) empty <- match.arg(empty) if(is.atomic(x)) return(x) x <- switch(toNA, keep = x, null = lapply(x, NVL, NA), empty = lapply(x, EVL, NA)) if(length(x)==0) switch(empty, keep=x, unlist=unlist(x, recursive=FALSE, ...)) else if(all(lengths(x)==1L) && all(vapply(x, is.atomic, logical(1)))) unlist(x, recursive=FALSE, ...) else x } #' A wrapper for base::attr which defaults to exact matching. #' #' @param x,which,exact as in \code{base::attr}, but with \code{exact} #' defaulting to \code{TRUE} in this implementation #' #' @return as in \code{base::attr} #' @examples #' #' x <- list() #' attr(x, "name") <- 10 #' #' base::attr(x, "n") #' #' stopifnot(is.null(attr(x, "n"))) #' #' base::attr(x, "n", exact = TRUE) #' @export attr <- function(x, which, exact = TRUE) { base::attr(x, which, exact) } statnet.common/R/wmatrix.R0000644000176200001440000002247614015667307015266 0ustar liggesusers# File R/wmatrix.R in package statnet.common, 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 2007-2019 Statnet Commons ####################################################################### #' A data matrix with row weights #' #' A representation of a numeric matrix with row weights, represented #' on either linear (`linwmatrix`) or logarithmic (`logwmatrix`) #' scale. #' #' @param x an object to be coerced or tested. #' @param data,nrow,ncol,byrow,dimnames passed to [`matrix`]. #' @param w row weights on the appropriate scale. #' @param target.nrows see [`decompress_rows`]. #' @param i,j,value rows and columns and values for extraction or #' replacement; as [`matrix`]. #' @param drop Used for consistency with the generic. Ignored, and #' always treated as `FALSE`. #' @param ... extra arguments, currently unused. #' #' @note Note that `wmatrix` itself is an "abstract" class: you cannot #' instantiate it. #' #' @note 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. #' #' @return 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. #' #' @seealso [`rowweights`], [`lrowweights`], [`compress_rows`] #' #' @name wmatrix #' #' @examples #' (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)) NULL #' @rdname wmatrix #' @export logwmatrix <- function(data = NA, nrow = 1, ncol = 1, byrow = FALSE, dimnames = NULL, w = NULL){ x <- matrix(data, nrow, ncol, byrow, dimnames) as.logwmatrix(x, w) } #' @rdname wmatrix #' @export linwmatrix <- function(data = NA, nrow = 1, ncol = 1, byrow = FALSE, dimnames = NULL, w = NULL){ x <- matrix(data, nrow, ncol, byrow, dimnames) as.linwmatrix(x, w) } #' @rdname wmatrix #' @export is.wmatrix <- function(x) inherits(x, "wmatrix") #' @rdname wmatrix #' @export is.logwmatrix <- function(x) inherits(x, "logwmatrix") #' @rdname wmatrix #' @export is.linwmatrix <- function(x) inherits(x, "linwmatrix") #' @rdname wmatrix #' @export as.linwmatrix <- function(x, ...) UseMethod("as.linwmatrix") #' @rdname wmatrix #' @export as.logwmatrix <- function(x, ...) UseMethod("as.logwmatrix") #' @rdname wmatrix #' @export as.linwmatrix.linwmatrix <- function(x, ...) x #' @rdname wmatrix #' @export as.linwmatrix.logwmatrix <- function(x, ...){ attr(x, "w") <- exp(attr(x, "w")) class(x)[class(x)=="logwmatrix"] <- "linwmatrix" x } #' @rdname wmatrix #' @export as.logwmatrix.logwmatrix <- function(x, ...) x #' @rdname wmatrix #' @export as.logwmatrix.linwmatrix <- function(x, ...){ attr(x, "w") <- log(attr(x, "w")) class(x)[class(x)=="linwmatrix"] <- "logwmatrix" x } #' @rdname wmatrix #' @export as.linwmatrix.matrix <- function(x, w=NULL, ...){ attr(x, "w") <- NVL(w, rep(1, nrow(x))) class(x) <- c("linwmatrix", "wmatrix", class(x)) x } #' @rdname wmatrix #' @export as.logwmatrix.matrix <- function(x, w=NULL, ...){ attr(x, "w") <- NVL(w, rep(0, nrow(x))) class(x) <- c("logwmatrix", "wmatrix", class(x)) x } #' @rdname wmatrix #' @export print.wmatrix <- function(x, ...){ x <- cbind(unclass(x), Weight = attr(x, "w")) print(x, ...) } #' @rdname wmatrix #' @export print.logwmatrix <- function(x, ...){ cat("A row-weighted matrix with natural-log-scaled weights:\n") NextMethod("print") } #' @rdname wmatrix #' @export print.linwmatrix <- function(x, ...){ cat("A row-weighted matrix with linear-scaled weights:\n") NextMethod("print") } #' Set or extract weighted matrix row weights #' #' @param x a [`linwmatrix`], a [`logwmatrix`], or a [`matrix`]; a #' [`matrix`] is coerced to a weighted matrix of an appropriate #' type. #' @param value weights to set, on the appropriate scale. #' @param update if `TRUE` (the default), the old weights are updated #' with the new weights (i.e., corresponding weights are multiplied #' on linear scale or added on on log scale); otherwise, they are #' overwritten. #' @param ... extra arguments for methods. #' #' @return 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. #' #' @name wmatrix_weights NULL #' @rdname wmatrix_weights #' @export rowweights <- function(x, ...) UseMethod("rowweights") #' @rdname wmatrix_weights #' @export rowweights.linwmatrix <- function(x, ...) attr(x, "w") #' @rdname wmatrix_weights #' @export rowweights.logwmatrix <- function(x, ...) exp(attr(x, "w")) #' @rdname wmatrix_weights #' @export lrowweights <- function(x, ...) UseMethod("lrowweights") #' @rdname wmatrix_weights #' @export lrowweights.logwmatrix <- function(x, ...) attr(x, "w") #' @rdname wmatrix_weights #' @export lrowweights.linwmatrix <- function(x, ...) log(attr(x, "w")) #' @rdname wmatrix_weights #' @export `rowweights<-` <- function(x, ..., value) UseMethod("rowweights<-") #' @rdname wmatrix_weights #' @export `rowweights<-.linwmatrix` <- function(x, update=TRUE, ..., value){ attr(x, "w") <- value * if(update) attr(x, "w") else 1 x } #' @rdname wmatrix_weights #' @export `rowweights<-.logwmatrix` <- function(x, update=TRUE,..., value){ attr(x, "w") <- log(value) + if(update) log(attr(x, "w")) else 0 x } #' @rdname wmatrix_weights #' @export `lrowweights<-` <- function(x, ..., value) UseMethod("lrowweights<-") #' @rdname wmatrix_weights #' @export `lrowweights<-.linwmatrix` <- function(x, update=TRUE, ..., value){ attr(x, "w") <- exp(value + if(update) log(attr(x, "w")) else 0) x } #' @rdname wmatrix_weights #' @export `lrowweights<-.logwmatrix` <- function(x, update=TRUE,..., value){ attr(x, "w") <- value + if(update) attr(x, "w") else 0 x } #' @rdname wmatrix_weights #' @export `rowweights<-.matrix` <- function(x, ..., value){ attr(x, "w") <- value class(x) <- c("linwmatrix", "wmatrix", class(x)) x } #' @rdname wmatrix_weights #' @export `lrowweights<-.matrix` <- function(x, ..., value){ attr(x, "w") <- value class(x) <- c("logwmatrix", "wmatrix", class(x)) x } #' A generic function to compress a row-weighted table #' #' 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). #' #' @param x a weighted matrix or data frame. #' @param ... extra arguments for methods. #' @return For \code{compress_rows} A weighted matrix or data frame of the same #' type with duplicated rows removed and weights updated appropriately. #' @export compress_rows <- function(x, ...) UseMethod("compress_rows") #' @rdname wmatrix #' @export compress_rows.logwmatrix <- function(x, ...){ o <- order.matrix(x) x <- x[o, , drop=FALSE] firsts <- !duplicated(x) groups <- cumsum(firsts) cx <- x[firsts, , drop=FALSE] attr(cx, "w") <- c(tapply(attr(x, "w"), list(groups), log_sum_exp), use.names=FALSE) cx } #' @rdname wmatrix #' @export compress_rows.linwmatrix <- function(x, ...){ o <- order.matrix(x) x <- x[o, , drop=FALSE] firsts <- !duplicated(x) groups <- cumsum(firsts) cx<-x[firsts, , drop=FALSE] attr(cx, "w") <- c(tapply(attr(x, "w"), list(groups), sum), use.names=FALSE) cx } #' @rdname compress_rows #' @export decompress_rows <- function(x, ...) UseMethod("decompress_rows") #' @rdname wmatrix #' @param 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. #' @export decompress_rows.wmatrix <- function(x, target.nrows=NULL, ...){ w <- rowweights(x) if(is.null(target.nrows)) target.nrows <- sum(w) n <- round(w/sum(w)*target.nrows) # Number of replications of each row rowweights(x) <- 1/n x[rep(seq_along(n), n),] } #' @rdname wmatrix #' @export `[.wmatrix` <- function(x, i, j, ..., drop=FALSE){ if(drop) warning("Row-weighted matrices cannot drop dimensions.") o <- unclass(x)[i,j,...,drop=FALSE] attr(o, "w") <- attr(x, "w")[i] class(o) <- class(x) o } #' @rdname wmatrix #' @export `[<-.wmatrix` <- function(x, i, j, ..., value){ o <- unclass(x) o[i,j,...] <- value attr(o, "w") <- attr(x, "w") class(o) <- class(x) o } statnet.common/R/control.utilities.R0000644000176200001440000005301014047641621017245 0ustar liggesusers# File R/control.utilities.R in package statnet.common, 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 2007-2020 Statnet Commons ####################################################################### .autodetect_dep_warn <- local({ warned <- c() function(caller = as.character(ult(sys.calls(),3)[[1L]])){ if(!caller %in% warned) warning("In ",sQuote(caller),": Autodetection of acceptable control parameter generators and of the calling function name has been deprecated and will be removed in a future version. They must be set explicitly.", call.=FALSE) warned <<- c(warned, caller) } }) #' Ensure that the class of the control list is one of those that can #' be used by the calling function #' #' 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. #' #' @param OKnames List of control function names which are acceptable. #' @param myname Name of the calling function (used in the error #' message). #' @param control The control list or a list to be converted to a #' control list using `control.myname()`. Defaults to the #' \code{control} variable in the calling function. See Details for #' detailed behavior. #' #' @note 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. #' #' @details `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. #' #' @return 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. #' #' @seealso [set.control.class()], [print.control.list()], [as.control.list()] #' @keywords utilities #' @export check.control.class <- function(OKnames=as.character(ult(sys.calls(),2)[[1L]]), myname=as.character(ult(sys.calls(),2)[[1L]]), control=get("control",pos=parent.frame())){ overwrite_control <- missing(control) control <- as.control.list(control, OKnames[1]) if(missing(OKnames) || missing(myname)) .autodetect_dep_warn() funs <- paste("control", OKnames, sep=".") # Control missing: overwrite default name in parent. if(overwrite_control) assign("control", control, pos=parent.frame()) if(inherits(control, funs[1L])) return(control) for(fun in funs[-1]) # If there is only one, that's a null vector, so it just terminates. if(inherits(control, fun)){ warning("Using ", fun,"(...) as the control parameter of ",myname,"(...) is suboptimal and may overwrite some settings that should be preserved. Use ",funs[1L],"(...) instead.") return(control) } stop("Invalid control parameters for ",myname,"(...): ",class(control)[1L],"(...). Use ",funs[1L],"(...) to construct them instead.", call.=FALSE) } #' Set the class of the control list #' #' This function sets the class of the control list, with the default being the #' name of the calling function. #' #' #' @param myname Name of the class to set. #' @param control Control list. Defaults to the \code{control} variable in the #' calling function. #' @return The control list with class set. #' @note 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. #' @seealso [check.control.class()], [print.control.list()] #' @keywords utilities #' @export set.control.class <- function(myname=as.character(ult(sys.calls(),2)[[1L]]), control=get("control",pos=parent.frame())){ if(missing(myname)) .autodetect_dep_warn() class(control) <- c(myname, "control.list", "list") control } #' Handle standard `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()]. #' #' @param myname the name of the calling function. #' @param ... the `...` argument of the control function, if present. #' #' @details 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()]. #' #' @return a list with formal arguments of the calling function. #' @export handle.controls <- function(myname, ...){ formal.args <- formals(sys.function(-1)) if(has.dots <- "..." %in% names(formal.args)) formal.args[["..."]] <- NULL control <- list() for(arg in names(formal.args)) control[arg] <- list(get(arg, parent.frame())) if(has.dots){ old.controls <- if(exists("old.controls", parent.frame())) get("old.controls", parent.frame()) else list() for(arg in names(list(...))){ if(is.null(newarg <- old.controls[[arg]])){ stop("Unrecognized control parameter for ", sQuote(paste0(myname, "()")), ": ", sQuote(arg), ".", call.=FALSE) }else if(is.list(newarg)){ newarg$action("Control parameter ",sQuote(paste0(arg,"=..."))," to ", sQuote(paste0(myname, "()")), " is no longer used.", newarg$message, call.=FALSE) }else{ warning("Passing ",sQuote(paste0(arg,"=..."))," to ", sQuote(paste0(myname, "()")), " is deprecated and may be removed in a future version. Specify it as ", sQuote(paste0(myname, "(", old.controls[[arg]], "=...)")), " instead.", call.=FALSE) control[old.controls[[arg]]]<-list(list(...)[[arg]]) } } } if(exists("match.arg.pars", parent.frame())) for(arg in get("match.arg.pars", parent.frame())) control[arg] <- list(match.arg(control[[arg]][1], eval(formal.args[[arg]]))) control } #' Pretty print the control list #' #' This function prints the control list, including what it can control and the #' elements. #' #' #' @param x A list generated by a \code{control.*} function. #' @param \dots Additional argument to print methods for individual settings. #' @param indent an argument for recursive calls, to facilitate indentation of nested lists. #' @seealso \code{\link{check.control.class}}, \code{\link{set.control.class}} #' @keywords utilities #' @export print.control.list <- function(x, ..., indent=""){ cat("Control parameter list generated by", sQuote(class(x)[1L]), "or equivalent. Non-empty parameters:\n") for(name in names(x)){ if(length(x[[name]])){ cat(indent, name,": ",sep="") if(is.list(x[[name]])) {print(x[[name]], ..., indent=paste0(indent," "))} else cat(paste(deparse(x[[name]]), collapse=" "),"\n", sep="") } } } #' Named element accessor for ergm control lists #' #' Utility method that overrides the standard `$' list accessor to disable #' partial matching for ergm \code{control.list} objects #' #' Executes \code{\link[base]{getElement}} instead of \code{\link[base]{$}} so #' that element names must match exactly to be returned and partially matching #' names will not return the wrong object. #' #' @param object list-coearceable object with elements to be searched #' @param name literal character name of list element to search for and return #' @return Returns the named list element exactly matching \code{name}, or #' \code{NULL} if no matching elements found #' @author Pavel N. Krivitsky #' @seealso see \code{\link{getElement}} #' @name control.list.accessor #' @export `$.control.list` <- function(object, name) object[[name, exact = TRUE]] #' Overwrite control parameters of one configuration with another. #' #' Given a \code{control.list}, and two prefixes, \code{from} and \code{to}, #' overwrite the elements starting with \code{to} with the corresponding #' elements starting with \code{from}. #' #' #' @param control An object of class \code{control.list}. #' @param from Prefix of the source of control parameters. #' @param to Prefix of the destination of control parameters. #' @return An \code{control.list} object. #' @author Pavel N. Krivitsky #' @seealso \code{\link{print.control.list}} #' @keywords utilities #' @examples #' #' (l <- set.control.class("test", list(a.x=1, a.y=2))) #' control.remap(l, "a", "b") #' #' @export control.remap <- function(control, from, to){ from <- paste0("^",from,"\\.") to <- paste0(to,"\\.") nfrom <- grep(from, names(control), value=TRUE) nto <- sub(from, to, nfrom) for(i in seq_along(nfrom)) control[[nto[i]]] <- control[[nfrom[i]]] control } #' Identify and the differences between two control lists. #' @param x a `control.list` #' @param y a reference `control.list`; defaults to the default #' settings for `x`. #' @param ignore.environment whether environment for #' environment-bearing parameters (such as formulas and functions) #' should be considered when comparing. #' @param ... Additional arguments to methods. #' #' @return 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. #' @export diff.control.list <- function(x, y=eval(call(class(x)[[1L]])), ignore.environment=TRUE, ...){ d <- list() for(name in union(names(x),names(y))){ d[[name]] <- if(is(x[[name]], "control.list") && is(y[[name]], "control.list")) EVL(diff(x[[name]], y[[name]])) else if(!identical(x[[name]],y[[name]],ignore.environment=ignore.environment)) list(x=x[[name]], y=y[[name]]) } structure(d, class=c("diff.control.list", "list"), xclass=c(class(x)[1L])) } #' @describeIn diff.control.list A print method. #' @param indent an argument for recursive calls, to facilitate #' indentation of nested lists. #' @export print.diff.control.list <- function(x, ..., indent = ""){ if(length(x)==0) cat("No difference between parameter lists generated by", sQuote(attr(x,"xclass")), "or equivalent.\n") else{ cat("Difference between parameter lists generated by", sQuote(attr(x,"xclass")), "or equivalent. Differences:\n") for(name in names(x)){ if(length(x[[name]])){ cat(indent, name,": ",sep="") if(is(x[[name]],"diff.control.list")) print(x[[name]], ..., indent=paste0(indent," ")) else if(is.list(x[[name]]$x)){ print(x[[name]]$x, ..., indent=paste0(indent," ")) cat("versus") print(x[[name]]$y, ..., indent=paste0(indent," ")) }else{ cat(paste(deparse(x[[name]]$x), collapse=" "), " versus ", paste(deparse(x[[name]]$y), collapse=" "), "\n", sep="") } } } } } #' Convert to a control list. #' #' @param x An object, usually a [`list`], to be converted to a #' control list. #' @param ... Additional arguments to methods. #' @return a `control.list` object. #' #' @examples #' 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)) #' @export as.control.list <- function(x, ...) UseMethod("as.control.list") #' @describeIn as.control.list Idempotent method for control lists. #' @export as.control.list.control.list <- function(x, ...) x #' @describeIn as.control.list The method for plain lists, which runs #' them through `FUN`. #' @param FUN Either a `control.*()` function or its name or suffix #' (to which `"control."` will be prepended); defaults to taking the #' nearest (in the call traceback) function that does not begin with #' `"as.control.list"`, and prepending `"control."` to it. (This is #' typically the function that called `as.control.list()` in the #' first place.) #' @param 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. #' @examples #' 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)) #' @export as.control.list.list <- function(x, FUN=NULL, unflat=TRUE, ...){ if(is.null(FUN)){ FUN <- ult( Filter(function(x) !startsWith(x, "as.control.list"), vapply( lapply(sys.calls(), # Obtain the traceback. `[[`, 1L), # Extract the function names as names. as.character, character(1)) # Convert to character vectors. ) # Drop those that begin with "as.control.list". ) # Take the last one. } if(is.character(FUN) && !startsWith(FUN, "control.")) FUN <- paste0("control.", FUN) FUN <- match.fun(FUN) if(unflat){ xnames_unused <- names(x) unflat <- function(f){ args <- formals(f) anames <- setdiff(names(args), "...") l <- list() for(aname in names(args)) if(aname %in% names(x)){ # Present in the input list: copy. l[aname] <- list(x[[aname]]) xnames_unused <<- setdiff(xnames_unused, aname) }else if(is.call(aval <- args[[aname]]) && startsWith(as.character(aval[[1]]), "control.")){ # A control list not supplied directly: process recursively. l[aname] <- list(unflat(get(as.character(aval[[1]]), pos=environment(f), mode="function"))) } # Otherwise, leave blank. l } x <- unflat(FUN) if(length(xnames_unused)) warning("Control arguments ", paste.and(sQuote(xnames_unused)), " not used in any of the control functions.", call.=FALSE, immediate.=TRUE) } do.call(FUN, x, envir=parent.frame()) } #' Statnet Control #' #' A utility to facilitate argument completion of control lists. #' #' 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`.) #' #' @param ... The parameter list is updated dynamically as packages #' are loaded and unloaded. Their current list is given below. #' #' @section Currently recognised control parameters: #' This list is updated as packages are loaded and unloaded. #' #' \Sexpr[results=rd,stage=render]{statnet.common::snctrl_names()} #' #' @note You may see messages along the lines of #' ``` #' The following object is masked from 'package:PKG': #' snctrl #' ``` #' when loading packages. They are benign. #' #' @export snctrl <- function(...){ control <- list(...) if(length(control)){ if(any(names(control)=="")) stop("All arguments to ",sQuote("snctrl")," must be named.", call.=FALSE) warning("The following arguments to ",sQuote("snctrl")," are not recognised: ", paste.and(sQuote(names(control))), call.=FALSE, immediate.=TRUE) } formal.args<-formals(sys.function()) formal.args[["..."]] <- NULL for(arg in names(formal.args)){ if(arg=="") stop("All arguments to ",sQuote("snctrl")," must be named.", call.=FALSE) if(!do.call(missing, list(arg))) control[arg] <- list(get(arg)) } control } #' @describeIn snctrl-API Typeset the currently defined list of #' argument names by package and control function. #' #' @export snctrl_names <- function(){ a <- argnames() pkgs <- sapply(names(a), function(pkg){ funs <- lapply(names(a[[pkg]]), function(ctrl){ ctrll <- nchar(ctrl) args <- names(a[[pkg]][[ctrl]]) paste0("\\item{\\code{\\link[",pkg,":",ctrl,"]{",ctrl,"}}}{\\code{", paste0(strwrap(paste0(args,collapse=", "),simplify=TRUE,exdent=ctrll+1),collapse="\n"), "}}") }) paste0("\\subsection{Package \\pkg{",pkg,"}}{\\describe{", paste0(funs,collapse="\n"),"}}") }) paste0(pkgs,collapse="\n") } argnames <- local({ cache <- list() delpkg <- function(pkgname,pkgpath){ cache[[pkgname]] <<- NULL update_snctrl() } function(pkg, arglists){ if(missing(pkg)) cache else{ cache[[pkg]] <<- arglists setHook(packageEvent(pkg, "onUnload"), delpkg) } } }) callbacks <- local({ cache <- list() delpkg <- function(pkgname,pkgpath){ cache[[pkgname]] <<- NULL } function(pkg, callback){ if(missing(pkg)) cache else{ cache[[pkg]] <<- callback setHook(packageEvent(pkg, "onUnload"), delpkg) } } }) #' @name snctrl-API #' @title Helper functions used by packages to facilitate [`snctrl`] updating. #' NULL #' @describeIn snctrl-API 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. #' #' @param myname Name of the package defining the arguments. #' @param arglists A named list of argument name-default pairs. If the #' list is not named, it is first passed through #' [collate_controls()]. #' @param callback A function with no arguments that updates the #' packages own copy of [snctrl()]. #' #' @return `update_snctrl()` has no return value and is used for its side-effects. #' @export update_snctrl <- function(myname, arglists=NULL, callback=NULL){ if(length(arglists) && all(names(arglists)=="")) arglists <- do.call(collate_controls, arglists) # Make a copy and replace the arglist. tmp <- snctrl if(!missing(myname)){ argnames(myname, arglists) if(!is.null(callback)) callbacks(myname, callback) } arglists <- c(argnames(),list(list(formals(tmp)[1]))) arglist <- unlist(unlist(lapply(unname(arglists), unname), recursive=FALSE), recursive=FALSE) argnames <- sort(unique(names(arglist))) arglist <- structure(rep(list(substitute()), length(argnames)), # For now, leave all default arguments blank. names = argnames) formals(tmp) <- arglist # Replace the original function with the copy. unlockBinding("snctrl", environment(snctrl)) snctrl <<- tmp lockBinding("snctrl", environment(snctrl)) for(callback in callbacks()) callback() invisible() } #' @describeIn snctrl-API Obtain and concatenate the argument lists of #' specified functions or all functions starting with dQuote(`control.`) in #' the environment. #' #' @param x Either a function, a list of functions, or an #' environment. If `x` is an environment, all functions starting #' with dQuote(`control.`) are obtained. #' @param ... Additional functions or lists of functions. #' #' @return `collate_controls()` returns the combined list of name-default pairs of each function. #' @export collate_controls <- function(x=NULL, ...){ l <- if(is.environment(x)) lapply(grep("^control\\.*", ls(pos=x), value=TRUE), mget, x, mode="function", ifnotfound=list(NULL)) else list(x) l <- unlist(c(list(...), l)) arglists <- lapply(l, formals) } #' @describeIn snctrl-API A stored expression that, if evaluated, will #' create a callback function `update_my_snctrl()` that will update #' the client package's copy of [snctrl()]. #' @format `UPDATE_MY_SCTRL_EXPR` is a quoted expression meant to be passed directly to [eval()]. #' @examples #' \dontrun{ #' # In the client package (outside any function): #' eval(UPDATE_MY_SCTRL_EXPR) #' } #' @export UPDATE_MY_SCTRL_EXPR <- quote( update_my_snctrl <- function(){ unlockBinding("snctrl", environment(update_my_snctrl)) snctrl <<- statnet.common::snctrl lockBinding("snctrl", environment(update_my_snctrl)) } ) #' @describeIn snctrl-API A stored expression that, if evaluated on #' loading, will add arguments of the package's `control.*()` #' functions to [snctrl()] and set the callback. #' @format `COLLATE_ALL_MY_CONTROLS_EXPR` is a quoted expression meant to be passed directly to [eval()]. #' @examples #' \dontrun{ #' # In the client package: #' .onLoad <- function(libame, pkgname){ #' # ... other code ... #' eval(statnet.common::COLLATE_ALL_MY_CONTROLS_EXPR) #' # ... other code ... #' } #' } #' @export COLLATE_ALL_MY_CONTROLS_EXPR <- quote( statnet.common::update_snctrl(pkgname, list(environment(.onLoad)), update_my_snctrl) ) statnet.common/R/mcmc-utils.R0000644000176200001440000000544514056622257015645 0ustar liggesusers# File R/mcmc-utils.R in package statnet.common, 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 2007-2021 Statnet Commons ####################################################################### #' @name mcmc-utilities #' @title Utility operations for [`mcmc.list`] objects #' #' @description \code{colMeans.mcmc.list} is a "method" for (non-generic) [`colMeans`] applicable to [`mcmc.list`] objects. #' #' @param x a \code{\link{mcmc.list}} object. #' @param \dots additional arguments to \code{\link{colMeans}} or #' \code{\link{sweep}}. #' @return \code{colMeans.mcmc} returns a vector with length equal to #' the number of mcmc chains in \code{x} with the mean value for #' each chain. #' @seealso [`colMeans`], [`mcmc.list`] #' @examples #' data(line, package="coda") #' summary(line) # coda #' colMeans.mcmc.list(line) # "Method" #' \dontshow{ #' stopifnot(isTRUE(all.equal(summary(line)$statistics[,"Mean"],colMeans.mcmc.list(line)))) #' } #' @export colMeans.mcmc.list colMeans.mcmc.list<-function(x,...) colMeans(as.matrix(x),...) #' @rdname mcmc-utilities #' #' @description \code{sweep.mcmc.list} is a "method" for (non-generic) #' [`sweep`] applicable to [`mcmc.list`] objects. #' #' @param STATS,FUN,check.margin See help for [`sweep`]. #' @return \code{sweep.mcmc.list} returns an appropriately modified #' version of \code{x} #' @seealso [`sweep`] #' @examples #' data(line, package="coda") #' colMeans.mcmc.list(line)-1:3 #' colMeans.mcmc.list(sweep.mcmc.list(line, 1:3)) #' \dontshow{ #' stopifnot(isTRUE(all.equal(colMeans.mcmc.list(sweep.mcmc.list(line, 1:3)), colMeans.mcmc.list(line)-1:3))) #' } #' @export sweep.mcmc.list sweep.mcmc.list<-function(x, STATS, FUN="-", check.margin=TRUE, ...){ for(chain in seq_along(x)){ x[[chain]] <- sweep(x[[chain]], 2, STATS, FUN, check.margin, ...) } x } #' @rdname mcmc-utilities #' #' @description \code{lapply.mcmc.list} is a "method" for (non-generic) #' [`lapply`] applicable to [`mcmc.list`] objects. #' #' @param X An [`mcmc.list`] object. #' @return `lapply.mcmc.list` returns an [`mcmc.list`] each of #' whose chains had been passed through `FUN`. #' @seealso [`lapply`] #' @examples #' data(line, package="coda") #' colMeans.mcmc.list(line)[c(2,3,1)] #' colMeans.mcmc.list(lapply.mcmc.list(line, `[`,,c(2,3,1))) #' \dontshow{ #' stopifnot(isTRUE(all.equal(colMeans.mcmc.list(line)[c(2,3,1)],colMeans.mcmc.list(lapply.mcmc.list(line, `[`,,c(2,3,1)))))) #' } #' @importFrom coda as.mcmc.list as.mcmc #' @export lapply.mcmc.list lapply.mcmc.list<-function(X, FUN, ...){ as.mcmc.list(lapply(lapply(X, FUN, ...), as.mcmc)) } statnet.common/R/string.utilities.R0000644000176200001440000000772014045135340017074 0ustar liggesusers# File R/string.utilities.R in package statnet.common, 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 2007-2020 Statnet Commons ####################################################################### #' Concatenates the elements of a vector (optionaly enclosing them in quotation #' marks or parentheses) adding appropriate punctuation and conjunctions. #' #' A vector \code{x} becomes "\code{x[1]}", "\code{x[1]} and \code{x[2]}", or #' "\code{x[1]}, \code{x[2]}, and \code{x[3]}", depending on the langth of #' \code{x}. #' #' #' @param x A vector. #' @param oq Opening quotation symbol. (Defaults to none.) #' @param cq Closing quotation symbol. (Defaults to none.) #' @param con Conjunction to be used if `length(x)>1`. (Defaults to "and".) #' @return A string with the output. #' @seealso paste, cat #' @keywords utilities #' @examples #' #' 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')) #' @export paste.and <- function(x, oq='', cq='', con='and'){ x <- paste(oq, x, cq, sep='') if(length(x)==0) return('') if(length(x)==1) return(x) if(length(x)==2) return(paste(x[1L],con,x[2L])) if(length(x)>=3) return(paste0(paste(x[-length(x)], collapse=", "),', ',con,' ',ult(x))) } #' [`print`] objects to the [`message`] output. #' #' A thin wrapper around [`print`] that captures its output and prints #' it as a [`message`], usually to STDERR. #' #' @param ... arguments to [`print`]. #' @param messageArgs a list of arguments to be passed directly to [`message`]. #' #' @examples #' 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)) # Silenced #' @export message_print <- function(..., messageArgs=NULL){ #' @importFrom utils capture.output do.call(message, c(list(paste(capture.output(print(...)),collapse="\n")), messageArgs)) } #' A one-line function to strip whitespace from its argument. #' @param s a character vector. #' @examples #' stopifnot(despace("\n \t ")=="") #' @export despace <- function(s) gsub("[[:space:]]", "", s) #' Format a p-value in fixed notation. #' #' 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`. #' #' @param pv,digits,eps,na.form,... see [format.pval()]. #' #' @return A character vector. #' #' @examples #' pvs <- 10^((0:-12)/2) #' #' # Jointly: #' fpf <- fixed.pval(pvs, digits = 3) #' fpf #' format.pval(pvs, digits = 3) # compare #' \dontshow{ #' stopifnot(all(fpf == c("1.000", "0.316", "0.100", "0.032", "0.010", "0.003", "0.001", "<0.001", "<0.001", "<0.001", "<0.001", "<0.001", "<0.001"))) #' } #' # Individually: #' fpf <- sapply(pvs, fixed.pval, digits = 3) #' fpf #' sapply(pvs, format.pval, digits = 3) # compare #' \dontshow{ #' stopifnot(all(fpf == c("1.000", "0.316", "0.100", "0.032", "0.010", "0.003", "0.001", "<0.001", "<0.001", "<0.001", "<0.001", "<0.001", "<0.001"))) #' } #' # Control eps: #' fpf <- sapply(pvs, fixed.pval, eps = 1e-3) #' fpf #' \dontshow{ #' stopifnot(all(fpf == c("1.000", "0.316", "0.100", "0.032", "0.010", "0.003", "0.001", "<0.001", "<0.001", "<0.001", "<0.001", "<0.001", "<0.001"))) #' } #' @export fixed.pval <- function(pv, digits = max(1, getOption("digits") - 2), eps = 10^-digits, na.form = "NA", ...) { if (missing(digits) && !missing(eps)) { digits <- ceiling(-log10(eps)) } o <- options(scipen = 200) on.exit(options(o)) format.pval(round(pv, digits), digits, eps = eps, na.form = na.form, nsmall = digits, ...) } statnet.common/NEWS.md0000644000176200001440000001670314056622111014326 0ustar liggesusers# statnet.common 4.5.0 ## New utilities * `ergm`'s term locator functions (`locate_function()` and `locate_prefixed_function()`) have been moved from `ergm`. * A new function, `default_options()`, a wrapper around `options()` that drops options already set. * A new function, `as.control.list()` generic and methods which take an R list and call an appropriate `control.*()` function on it. * `check.control.class()` now first runs the control argument through `as.control.list()` and overwrites, so `control=` arguments to many functions can be plain lists. * A new function, `simplify_simple()`, which takes a list and returns an atomic vector if the elements of the list are atomic and of length 1, with particular handling for `NULL` and empty (0-length) elements. * A new function, `snctrl()` (StatNet ConTRoL), designed so that argument completion will complete all available control functions. Looking up its help (`?snctrl`) produces a dynamic list of all control parameters and their packages and control functions that is updated as packages are loaded and unloaded. * A new function, `handle.controls()`, that performs the most normal functions in a `control.*()` function. * Two trivial helper functions, `base_env()` and `empty_env()`, to replace an object's environment with `baseenv()` and `emptyenv()`, respectively. * A new function, `fixed.pval()` that wraps `base::format.pval()` with better default arguments. * A reimplementation of `attr()` is exported, which disables partial matching by default. # Enhancements to existing utilities * `statnetStartupMessage()` now first looks for a `comment=(affil=...)` for the contributor's affiliation, before using e-mail. * Improved output formatting for `.Deprecate_once()`. * `append_rhs.formula()` now accepts NULL as the first argument, in which case it creates a new formula, and takes an additonal argument `env=`, which is used as this new formula's environment. # Miscellaneous changes * `rle` utilities are no longer reexported. * `statnet.common` no longer depends on `purrr`. * `statnetStartupMessage()` has been simplified. # statnet.common 4.4.0 ## `rle` utilities have been moved to a separate package, `rle` * Major methods are reexported, for now. ## New utilities * `split()` methods for matrices and arrays, to split them along a margin. * `trim_env()`, a generic that will replace an environment (possibly attached to another object) with a sub-environment containing only objects whose names are specified. * A `diff()` method for control lists and a `print()` method for the resulting differences. * `deInf()`, to replace `.deinf()` in package `ergm`. * A `compress()` generic, a `compress()` method for RLEs, and a `doNotCompress` argument to `rep.rle()`. Both `compact.rle()` and the `doNotCompact` argument to `rep.rle()` are now deprecated. ## Enhancements to existing utilities * Various optimizations have been made to RLEs. * `nonsimp_update.formula()` now handles both one and two sided formulas; it also now copies all names except `...` when `from.new = TRUE`. ## Bug fixes * `str.rle()` now works despite the overridden `length()` method. # statnet.common 4.3.0 ## New utilities * `EVL()`, a family of functions like `NVL()`, that treat any object of length 0 as `NULL`. * `once()`, a `purrr`-style adverb that wraps a function to only evaluate the first time it's called with a given configuration of arguments. * `persistEval()` and `persistEvalQ()` to retry evaluating a given expression a specified number of times. ## Bug fixes * In `forkTimeout()`, don't collect a process twice. Thanks to Tomas Kalibera for suggesting the fix. # statnet.common 4.2.0 ## New utilities * `.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`. * `forkTimeout()` evaluates an R expression with a hard time limit (except on Windows) by forking a process. Unlike `setTimeLimit()`, it enforces the limit even on native code. * `ult()` is a convenience function that extracts or replaces elements of a list indexed from the end. ## Miscellaneous * `statnet.common` now depends on R >= 3.5 due to what appears to be a method dispatching bug in earlier versions. * The package no longer Enhances `coda`. # statnet.common 4.1.4 ## New utilities * `despace()` removes whitespace from a string. * Pseudo-methods `colMeans.mcmc.list()`, `sweep.mcmc.list()`, and `lapply.mcmc.list()` (migrated from the `ergm` package). * `filter_rhs.formula()` selectively deletes terms in on the RHS of a formula. * `eval_lhs.formula()` extracts the LHS of the formula and evaluates it in the specified environment. * `NVL2()` and `NVL3()` for flexible substitution of null values. * `message_print()` formats its arguments as if for `print()` or `show()` methods, but then prints to stderr like `message()`. ## Enhancements to existing utilities * `paste.and()` now takes an additional `con=` argument, allowing a conjunction other than "and" to be used. * `ERRVL()` now uses lazy evaluation and lets the user dot-substitute the previous argument's try-error into the next argument. ## Bug fixes * Printing for control lists now works for function arguments. * A number of improvements to `rle` methods. ## Miscellaneous * A number of functions have been renamed for consistency: * `term.list.formula()` → `list_rhs.formula()` * `append.rhs.formula()` → `append_rhs.formula()` * `nonsimp.update.formula()` → `nonsimp_update.formula()` * Citation utilities have been deprecated, since CRAN's structure makes them unusable. # statnet.common 4.0.0 * The package now uses `Roxygen` for documentation. * `term.list.formula()` output format has been changed, since support of attributes on symbols is being deprecated. * A library of methods has been added for the base `rle` class, implementing concatenation, compaction, and a number of binary operations. * `all_same()` has been moved from ergm and renamed to `all_identical()`. * A new assignment method `NVL()<-` overwrites a variable if its value is NULL. * A set of classes and functions for manipulating and efficiently performing calculations on dense matrices or vectors with weighted rows or elements (possibly on the log scale) has been added. * New control parameter helper function, control.remap() has been added. Autodetection of function names by `set.control.class()` and `check.control.class()` has been deprecated and now results in a warning. * Improvements to the compressed data frame code, including an order() generic. * Miscellaneous robustifications added. * Native routine registration has been added. # statnet.common 3.3.0 * `append.rhs.formula()`, `vectors.namesmatch()`, `term.list.formula()`, and `ergm.update.formula()` (renamed to `nosimp.update.formula()`) moved from `ergm`. * Skye Bender-deMoll has been added as a contributor. # statnet.common 3.2.3 * `ERRVL()` moved from `ergm`. * Some `NAMESPACE` and other fixes to pass CRAN checks. # statnet.common 3.2.2 * control class improvements and bug fixes. # statnet.common 3.1.1 * Updated e-mail address * Some improvements to opttest. # statnet.common 3.1.0 * Initial release, incorporating the control class framework (`set.control.class()`, `check.control.class()`, `print.control.list()`); startup message framework; `NVL()`; `sort.data.frame()`; `compress.data.frame()`; `paste.and()`; citation utilities framework; and `opttest()` framework. statnet.common/MD50000644000176200001440000000674214056677262013563 0ustar liggesusers49c929387d26fa7891cb28dc0cc52a70 *DESCRIPTION 5dda17819ed27479d04f4c7422b7a754 *LICENSE 246ed43e6697bbaef16b9b17931ccc00 *NAMESPACE b543f842db46bce5a89a7ddc4475d40a *NEWS bca8ce683c2adc864dbc9999738e6714 *NEWS.md c2886abea0f8da4b3f83a92be063f949 *R/cite.utilities.R 3f401a693e77e2822fbaf415fedd4f08 *R/control.utilities.R 3d4e2f35fcf74d14f3778cb39e2b5fdd *R/deprecation_utils.R 3f58bfaa4a259a6a74643b35cfaf28f5 *R/formula.utilities.R f80d6b73ba53bf357b43a57bea5d19f5 *R/locator.R 489d008dc070cbd24196a900f1b80941 *R/logspace.utils.R 07d2aa49c0043a410ab7efc2e371c27d *R/mcmc-utils.R 66451a66f99775a296c7748c9819754f *R/misc.utilities.R 410b0a2835ea0fdd892bc1f66c11c5c9 *R/startup.utilities.R d41d8cd98f00b204e9800998ecf8427e *R/statnet.common-deprecated.R e1846a18c55dcedabc438cbd01a4a05b *R/string.utilities.R 23bbd65c07cd9924769a0439c7bea629 *R/wmatrix.R deee1f5004bea8b3ba633dc0f3554bc1 *R/zzz.R 0d44c847320bca83fe0a799653354b01 *build/statnet.common.pdf 1d7c769d04adb1c8d6a208b39cb33955 *inst/CITATION f211f683b8abe65250bca2aee3615824 *inst/templates/snctrl.R 7f2a94a498a5dc05b0503c5a31ab87b5 *man/ERRVL.Rd 3345b176e37cc9b908aaaa4d97b8c85b *man/NVL.Rd b8da6a5b1e1749ebb1e2bd91fee52ae4 *man/all_identical.Rd 5e6886f844400f8522640278c2c62f85 *man/as.control.list.Rd 3ba4d22fcc4e1337155a6718b5b96629 *man/attr.Rd 0a20ec0d0489a2fefd8888af5b0325fe *man/check.control.class.Rd 3d6c6870ce2f5e58298725cd06a2fe31 *man/compress_rows.Rd 9db58d7b6e6813c0ff3c304a6ea6814b *man/compress_rows.data.frame.Rd 69e165465cfe137f151e88da25d2c547 *man/control.list.accessor.Rd 3fdf8a833fede8838180c050d6cebf86 *man/control.remap.Rd c3be3a9476df5c0d8918f01dec3ccf18 *man/deInf.Rd 4fc9c8b806ec2ba21e3817d25a3e8250 *man/default_options.Rd fa99d54928bf41d5f6406879f140fc51 *man/deprecation-utilities.Rd 9855a7006964b42b31a34bc9419328d1 *man/despace.Rd 24c5ea090b2fb72870bf29feca1dd676 *man/diff.control.list.Rd cca9ecb70068bacf3dba0ebd3fabf32c *man/empty_env.Rd c7885722ddb46ab915a286cae1f096e4 *man/fixed.pval.Rd c9a722d71b353491bb1c93fdc0b228fe *man/forkTimeout.Rd d6b9eeabb15446bdd90205f6569021e7 *man/formula.utilities.Rd c4c4fd04ad2eb3987c562ee6725f7863 *man/handle.controls.Rd 855eee5dc6e63e289fcfbeeb1022cabe *man/locate_function.Rd 67a0fa905dcc1169b23184848aef9e1e *man/logspace.utils.Rd 2ec7bf6e6ec0694f6281ee30066fec43 *man/mcmc-utilities.Rd c4e645b96228c6f88533cf55dde327c6 *man/message_print.Rd 9a2a60603a701952ab439e01e0ab7316 *man/once.Rd b3f30472590e0c88122bae0f2fa585a7 *man/opttest.Rd 7f1cd031b808ff7070fcdba16ee1f164 *man/paste.and.Rd e99354e1d54c6d52f4991b071e15e5de *man/persistEval.Rd 55282e11ef7613fc90d2ddd222c9920c *man/print.control.list.Rd d12dde635ec286bc0a93b352aceb544f *man/set.control.class.Rd 740f941781269918f51d2162fddb38f1 *man/simplify_simple.Rd c25bbf56c40f1e65c9d4db47e39c325a *man/snctrl-API.Rd db36c190cc6f1988e85669058cc5cfde *man/snctrl.Rd a8de5de83cb42976a7fe04718debec89 *man/sort.data.frame.Rd 23afa368f513c4b3b06fad2aa62d4ef5 *man/split.array.Rd 9bbf055f43b721dac1b7c1077ae89537 *man/statnet.cite.Rd 893ba4da7f56b1f754582e0eebe430e1 *man/statnetStartupMessage.Rd e39f236ad480f70fa99a9619806380bd *man/sweep_cols.matrix.Rd f0608a307193d0f016d80b178678d198 *man/trim_env.Rd 32710045b53e1d71ddf2812bb93e4a83 *man/ult.Rd c3e0ca540da380a53d3d6d2f871f6932 *man/unwhich.Rd acf1f0b58218004dc025eb1a475d4ea1 *man/vector.namesmatch.Rd 3039ecb65762e63a9a0522855a1bd0be *man/wmatrix.Rd 127255b6fa25823caad8378cb7865bdd *man/wmatrix_weights.Rd 1906cf8e05b11f13b1319959b85ae201 *src/init.c b64a7d740f981d1c347639537883ca43 *src/logspace_utils.c statnet.common/inst/0000755000176200001440000000000014056636062014210 5ustar liggesusersstatnet.common/inst/templates/0000755000176200001440000000000014056632347016210 5ustar liggesusersstatnet.common/inst/templates/snctrl.R0000644000176200001440000000236114016053526017632 0ustar liggesusers# This document provides a template for exporting a package's # control.* functions to be visible to snctrl() and providing a # sensible help document. Currently, the packages have to be updated # manually when the template changes. ## Usage: # 1. Add the following line: # "eval(statnet.common::COLLATE_ALL_MY_CONTROLS_EXPR)" to the # .onLoad() function. It is important that the function's arguments # have their standard names ("libname" and "pkgname"). # # 2. Add the following text block to provide help. Note that the NULL is important, because otherwise, Roxygen will create an unsightly usage statement. # # 3. Run roxygen. # TODO: Figure out some automatic way to keep this in sync with statnet.common. ## BEGIN text block #' @name snctrl #' #' @title Statnet Control #' #' @description A utility `snctrl(...)`, to facilitate argument completion of control lists, reexported from `statnet.common`. #' #' @section Currently recognised control parameters: #' This list is updated as packages are loaded and unloaded. #' #' \Sexpr[results=rd,stage=render]{statnet.common::snctrl_names()} #' #' @seealso [statnet.common::snctrl()] #' @docType import NULL #' @export snctrl <- statnet.common::snctrl eval(UPDATE_MY_SCTRL_EXPR) # END text block statnet.common/inst/CITATION0000644000176200001440000000341714056636062015352 0ustar liggesusers#' statnet: statnet.cite.head("statnet.common") # ---- BEGIN AUTOGENERATED STATNET CITATION ---- citHeader(paste0(sQuote("statnet.common"), " is part of the Statnet suite of packages. ", "If you are using the ", sQuote("statnet.common"), " package for research that will be published, ", "we request that you acknowledge this by citing the following.\n", "For BibTeX format, use toBibtex(citation(\"", "statnet.common", "\")).")) # ---- END AUTOGENERATED STATNET CITATION ---- #' statnet: statnet.cite.pkg("statnet.common") # ---- BEGIN AUTOGENERATED STATNET CITATION ---- bibentry("Manual", author = structure(list(list(given = "Pavel N.", family = "Krivitsky", role = c("aut", "cre"), email = "pavel@statnet.org", comment = c(ORCID = "0000-0002-9101-3362", affiliation = "University of New South Wales" ))), class = "person"), title = paste("statnet.common", ": ", gsub("\n", " ", "Common R Scripts and Utilities Used by the Statnet Project Software", fixed = TRUE), sep = ""), organization = paste0("The Statnet Project (\\url{", "https://statnet.org", "})"), year = substr("2021-06-05", 1, 4), note = paste("R package version ", "4.5.0", sep = ""), url = paste0("https://CRAN.R-project.org/package=", "statnet.common")) # ---- END AUTOGENERATED STATNET CITATION ---- #' statnet: statnet.cite.foot("statnet.common") # ---- BEGIN AUTOGENERATED STATNET CITATION ---- citFooter(paste0("We have invested a lot of time and effort in creating the ", "Statnet suite of packages for use by other researchers. ", "Please cite it in all papers where it is used. The package ", sQuote("statnet.common"), " is distributed under the terms of the license ", "GPL-3 + file LICENSE", ".")) # ---- END AUTOGENERATED STATNET CITATION ----