network/0000755000176200001440000000000014061574702011751 5ustar liggesusersnetwork/NAMESPACE0000644000176200001440000001230114060054371013157 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method("!",network) S3method("$",mixingmatrix) S3method("%c%",network) S3method("&",network) S3method("*",network) S3method("+",network) S3method("-",network) S3method("[",network) S3method("[<-",network) S3method("[[",mixingmatrix) S3method("|",network) S3method(add.edge,network) S3method(add.edges,network) S3method(add.vertices,network) S3method(as.data.frame,network) S3method(as.edgelist,matrix) S3method(as.edgelist,network) S3method(as.edgelist,tbl_df) S3method(as.matrix,network) S3method(as.matrix.network,adjacency) S3method(as.matrix.network,edgelist) S3method(as.matrix.network,incidence) S3method(as.network,data.frame) S3method(as.network,default) S3method(as.network,matrix) S3method(as.network,network) S3method(as.tibble,network) S3method(as_tibble,network) S3method(delete.edge.attribute,network) S3method(delete.network.attribute,network) S3method(delete.vertex.attribute,network) S3method(get.edge.attribute,list) S3method(get.edge.attribute,network) S3method(get.edge.value,list) S3method(get.edge.value,network) S3method(get.network.attribute,network) S3method(get.vertex.attribute,network) S3method(is.bipartite,mixingmatrix) S3method(is.bipartite,network) S3method(is.directed,mixingmatrix) S3method(is.directed,network) S3method(is.na,network) S3method(list.edge.attributes,network) S3method(list.network.attributes,network) S3method(list.vertex.attributes,network) S3method(mixingmatrix,network) S3method(network.dyadcount,network) S3method(network.edgecount,network) S3method(network.naedgecount,network) S3method(network.size,network) S3method(plot,network) S3method(plot.network,default) S3method(print,mixingmatrix) S3method(print,network) S3method(print,summary.network) S3method(prod,network) S3method(set.edge.attribute,network) S3method(set.edge.value,network) S3method(set.network.attribute,network) S3method(set.vertex.attribute,network) S3method(sum,network) S3method(summary,network) export("!.network") export("%c%") export("%c%.network") export("%e%") export("%e%<-") export("%eattr%") export("%eattr%<-") export("%n%") export("%n%<-") export("%nattr%") export("%nattr%<-") export("%s%") export("%v%") export("%v%<-") export("%vattr%") export("%vattr%<-") export("&.network") export("*.network") export("+.network") export("-.network") export("<-.network") export("[.network") export("[<-.network") export("network.vertex.names<-") export("|.network") export(add.edge) export(add.edge.network) export(add.edges) export(add.edges.network) export(add.vertices) export(add.vertices.network) export(as.color) export(as.data.frame.network) export(as.edgelist) export(as.edgelist.matrix) export(as.matrix.network) export(as.matrix.network.adjacency) export(as.matrix.network.edgelist) export(as.matrix.network.incidence) export(as.network) export(as.network.data.frame) export(as.network.default) export(as.network.matrix) export(as.network.network) export(as.sociomatrix) export(delete.edge.attribute) export(delete.edges) export(delete.network.attribute) export(delete.vertex.attribute) export(delete.vertices) export(get.dyads.eids) export(get.edge.attribute) export(get.edge.value) export(get.edgeIDs) export(get.edges) export(get.inducedSubgraph) export(get.neighborhood) export(get.network.attribute) export(get.vertex.attribute) export(has.edges) export(has.loops) export(is.adjacent) export(is.bipartite) export(is.color) export(is.directed) export(is.discrete) export(is.discrete.character) export(is.discrete.numeric) export(is.edgelist) export(is.hyper) export(is.multiplex) export(is.na.network) export(is.network) export(list.edge.attributes) export(list.network.attributes) export(list.vertex.attributes) export(mixingmatrix) export(network) export(network.adjacency) export(network.arrow) export(network.bipartite) export(network.copy) export(network.density) export(network.dyadcount) export(network.edgecount) export(network.edgelabel) export(network.edgelist) export(network.incidence) export(network.initialize) export(network.layout.circle) export(network.layout.fruchtermanreingold) export(network.layout.kamadakawai) export(network.loop) export(network.naedgecount) export(network.size) export(network.vertex) export(network.vertex.names) export(permute.vertexIDs) export(plot.network) export(plot.network.default) export(plotArgs.network) export(print.network) export(print.summary.network) export(prod.network) export(read.paj) export(set.edge.attribute) export(set.edge.value) export(set.network.attribute) export(set.vertex.attribute) export(sum.network) export(summary.network) export(valid.eids) export(which.matrix.type) import(utils) importFrom(grDevices,colors) importFrom(grDevices,gray) importFrom(graphics,locator) importFrom(graphics,par) importFrom(graphics,plot) importFrom(graphics,polygon) importFrom(graphics,rect) importFrom(graphics,strheight) importFrom(graphics,strwidth) importFrom(graphics,text) importFrom(magrittr,"%>%") importFrom(magrittr,set_names) importFrom(statnet.common,NVL) importFrom(statnet.common,once) importFrom(statnet.common,simplify_simple) importFrom(statnet.common,statnetStartupMessage) importFrom(stats,na.omit) importFrom(stats,rnorm) importFrom(tibble,as.tibble) importFrom(tibble,as_tibble) importFrom(tibble,tibble) useDynLib(network, .registration = TRUE) network/ChangeLog0000644000176200001440000010443214060057272013524 0ustar liggesusersCHANGELOG: v1.17.1 - Coercion from an edgelist could fail with a single edge when redundant edges were being removed. - Zero-row matrices are now assumed to be empty edgelists when not explicitly specified. (Before, they just failed.) v1.17 - Michal Bojanowski, Pavel N. Krivitsky, Chad Klumb, and Brendan Knapp have been added as contributors. - summary.character() and print.summary.character() are no longer exported as it interfered with base::summary.data.frame(). - Added functions as.network.data.frame and as.data.frame.network for converting between data.frames and networks. - as.tibble.network and as_tibble.network now optionally return edge IDs, controlled with the store.eid argument - Fixes to read.paj(). - Various testthat improvements. - Bugs fixed in mixingmatrix.network(). - Updated tests for compatibility with R 4.0 - Converted is.bipartite, is.directed, get.edge.attribute, get.edge.value, get.network.attribute, list.edge.attributes, list.network.attributes, set.vertex.attribute, set.edge.attribute, set.edge.value, set.network.attribute, delete.vertex.attribute, delete.edge.attribute, delete.network.attribute, has.vertex.attribute, has.edge.attribute, and has.network.attribute to generics for greater extensibility. - Using an out-of-bounds index in nw[i,j] and nw[i,j]<- now produces a sensible error message (i.e., same one as for a matrix). - mixingmatrix() now produces output inheriting from "table" rather than a list; its printing, handling of missing attributes, bipartite networks, and other scenarios has been improved. - as.mixingmatrix() has been added. - network now uses statnet::statnetStartupMessage(). - Updated constructor code per Kurt Hornik's suggestion to future proof versus upcoming sapply() changes. - network.edgelist() now automagically prunes loops and redundant edges for networks that should not have them; previously, the function trusted the user not to supply such things (and would go ahead and make edges if asked to do so). v1.16 - Converted get.vertex.attribute and list.vertex.attributes to generics for greater extensibility. - Updated tests to fix a color-related issue. - Switched explicit class matching checks to inherits(). This avoids a compatibility problem with future R releases (and facilitates further class extensions). v1.15 - made na.omit a non-required arguments S3 method generics for network.edgecount and network.dyadcount for exensibility by downstream packages v1.14 Fixes & Features - revamped the network C API, which had been broken by earlier regrestration changes. Users making use of the C API will need to update their networkapi.c and networkapi.h files, but no other changes need to be made to existing code. - Fixed an un-handled case for plot edge.lwd expansion when called from other contexts. It can now replicate a single numeric value even if scaling is not otherwise included. - network now has an as_tibble() method to convert it to a tibble edgelist with specified edge attributes as columns or to a tibble vertex list with vertex attributes as columns. - as.edgelist() can return a tibble as well. - network print() methods now handle formula network attributes intelligently. - mixingmatrix() is now a generic, with a mixingmatrix.network() method. - Improved handling for NAs in network subsetting assignment operation. - A number of functions (network.edge.count(), network.dyadcount(), network.naedgecount(), and network.size()) are now generics. - Assigning a vector (as opposed to a matrix) to %e% (edge attribute) now sets the edge attribute of corresponding edges (in the same order as the internal representation). - Various changes made to satisfy CRAN's ever-shifting code requirements. v1.13 Fixes & Features - added some CRAN requested imports to NAMESPACE - added get.dyads.eids function to return sets of edge ids for vectors of tails and heads vertex ids for non-multiplex networks - copied as.edgelist functions from ergm, they serve as wrapper for as.matrix.edgelist.network that enforces sorting and adds an 'edgelist' class. - added a has.edges() function to determine if a vertex has any edges (is not an isolate) - updated network.dyadcount to account for loops and directed bipartite networks - added optional opacity paramter to as.color, and new docs for as.color. - rewrote read.paj() parser for Pajek formatted files, now supports timing and edge attributes, fixes error for empty network - added Suggests dependency for testthat for testing v1.12 Fixes & Features - fix error with as.matrix.network.edgelist when as.sna.edgelist=TRUE and network has 0 edges - updated citation generation code - NAMESPACE file updated to explicitly register S3 methods (and some pseduo S3 methods as requested by CRAN check) - changing the vertex.sides argument to plot.network now produces polygons of equal area instead of equal radius. - plot.network can now plot labels on curved edges - refactored plot.network so that much of the argument expansion is handled by a public method plotArgs.network so that it can be accessed by depending packages v1.11 Fixes & Features - minor change to layout.c to fix UBSAN warning flagged by CRAN - minor changes to print.network to give more informative info about some network attributes - get.edge.attribute now has C-level backend - get.edge.attribute and get.edge.value now have arguments to avoid returning attribute values from 'missing' edges (na.omit) and unset/deleted edges (deleted.edges.omit) and edges with no value assigned for the attribute (null.na). - network now includes an explicit list of exported functions in NAMESPACE - the following 'internal' functions have been removed from NAMESPACE: networkOperatorSetup, switchArcDirection, readAndVectorizeLine, read.paj.simplify - network now follows R conventions for exporting some of its C-level API functions for use by other packages - get.inducedSubgraph() now has an optional 'eid' argument for inducing a network including specified edges and their incident vertices - fixed bug in as.network.matrix that caused it to ignore the na.rm argument. - added patch to which.matrix. type to handle NAs submitted by Philip Leifeld - fixed na.rm argument to as.network.matrix - changed plot function to force lazy evaluation of displaylabels=!missing(label) argument before value of label is changed v1.10 Fixes - fixed vertex label plotting bug when vertices have the same positions - added dimension checks and more informative error for as.network.matrix for case when it assumes a square edgelist is an adjacency matrix - added dependency on statnet.common library to facilitate some development testing - The 'modify in place' syntax for network functions that modify their arguments now works correctly when the network to be modified is an element of a list - Modified plot.network.default so that if a single value is passed in that matches with a vertex attribute name, the value of the attribute will be used (to make it consistent with the rest of the plot arguments) - Fix to C-level stack protection bug in delete.vertices that could cause crashes under some conditions - removed $<-.network assignment operator so that dispatch will occur via R internals. - Fix stack protection overflow in set.edge.value. Also check for correct dimension on value argument for set.edge.value. - Minor documentation fixes v1.9 Features & Fixes New Features - minor tweak to print.network to not show summary information for net.obs.period and .active attributes when called from network dynamic - add.vertices, add.edge, and add.edges have been converted to S3 methods - set.vertex.attributes and set.edge.attributes can now modify a list of on a network attributes with a single call - modified all of the set and add methods to remove the x$RisTooLazy?<-NULL copy-inducing kludge in favor of x<-duplicate(x) in the C version of the function. Seems to give moderate speed improvement for large networks Fixes - fixed a c-level bug in get.edge.ids that was giving bad values on undirected networks with loops. - fixed a bug where [<-.network assignment operator fails to add edge in non-directed loops case v1.8 Fixes & Features New Features - now supports bipartite networks with zero-sized first mode. (bipartite=0 no longer means the same thing as bipartite=FALSE, and is.bipartite() reflects this) - added vertex.lwd attribute to plot.network for controlling line widths around vertices - added basic plotting for edge labels (new plot.network arguments: edge.label, edge.label.cex, edge.label.col) - added valid.eids function to return the ids of non-NULL edges in a network - added a loading.attributes man page with more examples of attaching vertex and edge attributes - print.network now lists edge attributes if there are less than 1k edges, otherwise a notice that attribute names are not shown (listing edge attributes is expensive) Bug Fixes - permute.vertexIDs was triggering a protection stack overflow on large graphs. - fixes for the undirected network subtraction operator and ! operator bug. resolution involved forcing a i=2.0). [CTB] Bug Fixes: - The network summary and print methods could in some cases fail if called on a network with non-trivial graph-level attributes. [CTB, submitted by Zack Almquist; closely related bug fixed by MSH] - If called with ignore.eval=T but no specified names.eval, as.network and friends generated an object with mislabeled edge attributes; note that a warning is still given with such a call, since it is unwise not to specify attribute names. [CTB, submitted by DH] v1.6 Changes/Bug Fixes Changes: - In-place modification methods now use draconian measures to force evaluation of their arguments prior to modification, and overwrite non-anonymous arguments in their original frame on exit. This is a kludge to cope with R's lazy evaluation strategy, which does not play well with in-place modification of arguments. Bug Fixes: - Per the above, semantics for in-place modification of objects should now operate correctly (was conflicting with R's lazy evaluation scheme, sometimes resulting in bizarre behavior). [CTB, submitted by Ronggui Huang] - plot.network was failing when edge.col was called with single color terms. [CTB, submitted by Philip Leifeld] - network.layout.fruchtermanreingold failed when called with a network having exactly one edge. [DRH] v1.5-1 Minor Changes/Bug Fixes Changes: - The mixingmatrix function has been moved from ergm to network (currently as an undocumented internal function). [CTB, but original function is due to MSH] Bug fixes: - plot.network generated an error in some cases when edge.curv was set. [CTB, submitted by Brian Ripley] - summary.network generated an error if mixingmatrices=TRUE was set and ergm was not loaded. (The mixingmatrix function has now been moved into the network package.) [CTB, submitted by Ronggui Huang] v1.5 New Functions, New Features, Changes, and Bug Fixes New Functions: - get.inducedSubgraph: return induced subgraphs and edge cuts from a network object. A new operator, %s%, has been introduced to simplify this process. [CTB] New Features: - add.vertices now supports adding vertices to the first mode of a bipartite network (default behavior is unchanged). [CTB] - as.matrix.network.adjacency and as.sociomatrix now support an optional argument to force bipartite graphs to be returned in full one-mode adjacency form (rather than the current, two-mode default). [CTB] - print.network and print.summary.network now support an argument to allow suppression of matrix output (helpful for very large graphs). [CTB] - network.layout.fruchtermanreingold now uses a cell-based acceleration scheme for large graphs, which can be adjusted using layout.par; it also operates entirely on edgelists, and is no longer O(N^2) in typical applications. - Network coercion methods now recognize/use sna edgelist attributes (even if the matrix is not actually an sna edgelist!) automagically. Coercion to edgelist form also sets the sna edgelist attributes. In addition to being useful for interoperability, this now makes it easier to import network data in edgelist form (previously, one had to be careful about setting vertex sizes, which could only be crudely inferred from the edgelist matrix itself). [CTB] Changes: - By very popular demand, network now uses R name spaces. [Credit to Michal Bojanowski for convincing us to make the leap] - Also by popular demand, print.network no longer displays the network itself by default. [CTB] - Elementwise network operators now support multigraphs, and use basic network attributes in a sane way. Operator semantics have been substantially expanded for the muligraph case; hypergraphs are not yet supported, but missingness is. [CTB, submitted by MSH] - Support for bipartite graphs in read.paj has been improved. [MSH] - In addition to changes noted above, network.layout.fruchtermanreingold uses a lightly different repulse radius by default; this seems to work better on large graphs. [CTB] - plot.network has some overdue performance enhancements, including a more scalable Fruchterman-Reingold implementation. Note that plot.network no longer coerces anything to adjacency form, although particular layout methods might. [CTB] Bug Fixes: - add.edge and add.edges would crash when called with NA vertex IDs in the head or tail lists. [CTB, submitted by Skye Bender-deMoll] - is.na.network failed when called on networks with deleted edges. [CTB, submitted by MSH] - network.dyadcount handled NAs improperly in some cases. [MSH] - network.initialize now stops with an error when called with <=0 vertices, rather than producing undefined behavior. [CTB, submitted by Skye Bender-deMoll] - Various minor issues in plot.network have bee fixed. [CTB, mostly based on imports from gplot in sna; some gplot fixes contributed by Alex Montgomery] - print.network and print.summary.network could fail when called on multiplex or hypergraphic networks with the wrong matrix.type settings. [CTB] v1.4-1 Minor Changes/Bug Fixes Changes: - print.summary.character now behaves in a more intuitive way (and always generates at least marginally useful output). [CTB] - print.summary.network has been rewritten -- too much confusion about what it was supposed to do. [CTB] - The na.omit option to print.summary.network and print.network should now be considered deprecated (it does essentially nothing at this point. [CTB] Bug Fixes: - print.summary.network was giving the same information twice (and other information badly. [CTB] v1.4 New Functions, New Features, Changes, and Bug Fixes New Functions: - is.na.network: returns a network whose edges correspond to missing edges in the original network. (Also supported by new backend function isNANetwork_R.) [CTB] - network.naedgecount: returns the number of missing edges in a network object. [CTB] - Internal functions summary.character and print.summary.character have been added for use with network print/summary methods. [MSH] - Internal function is.color has been added to allow heuristic identification of color names (for use with attribute plotting). as.color similarly attempts to coerce its input into some reasonable color value for display purposes. [CTB] New Features: - The network edge assignment operator ([<-.network) now allows NAs to be given as assignment values (resulting in missing edges if no attribute specified, or missing attribute values otherwise). [CTB] - The C-level network API headers are now contained in the "inst" directory; from now on, they will be maintained there. [CTB] - read.paj now imports vertex attributes. [Patch submitted by Alexander Montgomery] Changes: - Many minor documentation updates (including adding references to the recent JSS article). [CTB] - CITATION file has been updated to reflect current R standards. [CTB] - Color support in plot.network.default has been greatly expanded and rationalized. [CTB] - is.adjacent now sets na.omit=FALSE by default; there seems to be a general consensus that this results in the more obvious pattern of behavior (i.e., missing edges from i to j result in a value of NA, unless there are also non-missing (i,j) edges present). The man page has also been updated to describe this behavior in greater detail. [CTB] - Per the above, as.sociomatrix and related coercion methods also now display missing data information by default. [CTB] - summary.network now returns a summary.network object, and printing takes place within print.summary.network (which is standard R behavior). Something approximately like this was being done before, but behavior should now be more conventional; summary.network objects can also carry optional information as network attributes with names of the form "summary.*". [CTB; Submitted by DRH] - plot.network.default now automagically displays labels if manually supplied (following the behavior of sna's gplot). [CTB] - print.network now shows missing edge information. [CTB] - The man page for network.dyadcount now emphasizes the fact that directed dyads are returned when is.directed(x)==TRUE. (This was noted in the example, but was explicitly discussed in the main page.) [CTB; Submitted by DRH] - as.matrix.network.edgelist and as.matrix.network.incidence now return degenerate matrices instead of NULL when called with an empty graph. [Pavel Krivitsky] - Undocumented support for the design matrix and special "respondent" attributes should be considered deprecated, and will be removed in the next version. [CTB] Bug Fixes: - as.matrix.network.edgelist dropped the dimensions of its output when called on a graph with one edge. [CTB] - as.matrix.network.incidence produced an error when called with an empty graph, and generated incorrect matrices when called with graphs containing missing or previously deleted edges. [CTB] - get.neighborhood was incorrectly including ego for loopless undirected graphs. [CTB] - list.vertex.attributes produced an error when called on networks with different attributes on each vertex. [CTB] - plot.network.default was not displaying colors as advertised in some cases [CTB; Submitted by Cori Mar] - print.network and summary.network were giving ugly output. [MSH] - read.paj was reversing arc directions. [CTB; Submitted by Kevin Lewis] - The initial startup message was giving the wrong help command. [CTB; Submitted by Kevin Zembower] - read.paj was failing in some cases. [Pavel Krivitsky] - summary.network didn't call the mixing matrix summary properly. [MSH] v1.3 New Functions, New Features, Changes, and Bug Fixes New Functions: - network.vertex.names<-: simplified assignment for vertex names. [CTB] New Features: - A CITATION file has now been added to the package, to encourage good behavior. The initial on-load announcements have been tweaked accordingly. [CTB] Changes: - add.edges (via the backend routine add_edges_R) now adds edges in a more efficient way; substantial performance gains should be observed when adding multiple edges at one time, versus previous package versions. [CTB] - network print and summary methods now consistently refer to "vertex attributes" instead of "nodal attributes." [CTB] - network constructors now set vertex names by default; this brings the actual behavior of the package in line with its apparent behavior (since network.vertex names and similar routines will "fake" vertex names if none are present, thus producing results which are inconsistent with get.vertex.attribute in the latter case). [CTB] - The DESCRIPTION file has been tweaked to be a bit more professional, and to add the statnet web site. [CTB] Bug Fixes: - Fixed "virtual subsetting" for network objects when a single vector of virtual cell numbers is provided, or when a one-row, two-column matrix is given. In both cases, network was treating the numbers as if they were first-column selectors. [CTB] - Direct assignment to internal components of network objects was failing in certain cases. This has been fixed, although users should note that this behavior is both unsupported and generally a Bad Idea (TM). Please use interface methods instead! [CTB; Submitted by Skye Bender-deMoll] - Fixed bug in read.paj. [MSH] - Fixed display of attribute information in summary.network. [MSH] - plot.network is now compatible with the updated ergm package. [CTB] - Previously implemented functionality in plot.network allowing one-word specification of vertex or edge attributes for display parameters was not working uniformly. [CTB] v1.2 New Functions, Changes, Bug Fixes New Functions: - $<-.network: replacement method for network objects. [CTB] - sum.network, prod.network: sums and products of multiple network objects. [CTB] Changes: - Direct assignments with network objects on the right-hand side now copy their right-hand argument (per standard R semantics). Originally, a pointer to the right-hand argument was copied (and network.copy was required for direct assignment). The direct use of network.copy is now unnecessary for most purposes, and should be avoided. [CTB] - network.density now allows explicit control of missing data behavior, support for ignoring "structural zeros" (per bipartite), and supports a wider range of hypergraphic cases. [CTB] - Some adjustments have been made to the overloading of network arithmetic operators, to ensure compatibility with future versions of R. Most importantly, the passing of an attrname argument to arithmetic operators is now defunct (since it violates the S3 generics). The addition of more general sum and prod methods hopefully make up for this regression. [CTB] - The network extraction and assignment operators now behave more like conventional matrices. In particular, single vectors are assumed to contain lists of cell indices (when given in isolation), and one-row, two-column matrices are treated as other two-column matrices. [CTB] - Various minor documentation and test file updates. [CTB] Bug Fixes: - as.matrix arguments have been modified to harmonize with the new R (2.5) generics definitions. [CTB] - Annoying but harmless tracer messages have been removed. [CTB] - Protection stack could overflow when large numbers of edges were deleted in a single call. [CTB; Submitted by Pavel Krivitsky] v1.1-2 Changes, Bug Fixes Changes: - getNeighborhood, getEdges, and getEdgeIDs (internal) now force type="combined" behavior on undirected networks; this was done at the R level before, but is now enforced in C as well. This is not generally user-level transparent, but affects the experimental network API [CTB] Bug Fixes: - as.network.matrix was not setting the bipartite attribute of the returned network properly, when called with a non-FALSE bipartite argument [MSH] - An error was present in some error return functions, causing errors on errors (which, happily, were only relevant when an error occurred) [CTB; Submitted by Skye Bender-deMoll] v1.1-1 New Functions, Changes New Functions: - The internal function setVertexAttribute has been added. This has no immediate user-level effect, but the new function is supported in the C API [CTB] Changes: - Use of the protection stack has been changed, so as to avoid racking up huge stacks when creating very large networks. This is expected to have a minimal impact on performance, but will avoid protection stack overflow issues in some cases [CTB] - A change in R 2.4.0 has apparently made it impossible for generic two-argument Ops (e.g., +,-,*) to dispatch to functions with more than two arguments. A side effect of this is that "+.network" and friends must be called with the full function name (as opposed to simply "+") when the optional attrname argument is being used. Note that this is not a change in the network package (although the test code has been updated to reflect it), but a regression due to R. Go complain to the R team [CTB] v1.1 New Features, Bug Fixes, Changes New Features: - [.network and [<-.network now allow the use of vertex names (where present) for selection of vertices [CTB] Bug Fixes: - add.vertices did not verify the integrity of vattr, and could generate a segfault if incorrectly called with a non-null, non-list value [CTB; reported by Skye Bender-deMoll] - as.network (and friends) could segfault if matrix.type was forced to adjacency while bipartite>0; new behavior essentially forces the use of the bipartite matrix method in this case [CTB] - delete.edges and set.edge.attribute returned an annoying (but harmless) warning when called with zero-length eid [CTB; reported by David Hunter] - delete.vertices did not adjust bipartite attribute (where present) to account for loss of mode 1 vertices [CTB] - get.vertex.attribute generated an error when called with na.omit=TRUE in some cases [CTB] - network.incidence could not be used to construct undirected dyadic networks [CTB] - set.vertex.attribute generated an error if called with attribute lists of length != network.size [CTB; reported by Skye Bender-deMoll] Changes: - Added a new overview man page (network-package) with information on how to get started with network [CTB] - [<-.network will now remove edges with zero values if both names.eval and add.edges are set, and will not add edges for those cells. Previously, the standard behavior was to add edges for all cells [CTB] - Added delete.edges to the "see also" for add.edges [CTB; suggested by Skye Bender-deMoll] - permute.vertexIDs now throws a warning when called with a cross-mode vertex exchange on a bipartite graph [CTB] - Default matrix type for as.matrix.network is now "adjacency," rather than the output of which.matrix.type(). Coercion methods should not have variable behavior depending on features such as network size, even if it is convenient for some purposes! The old behavior can be easily obtained via setting matrix.type=which.matrix.type(x), for those who want it [CTB] v1.0-1 Minor Bug Fixes, Changes Bug Fixes: - Various warnings were removed (apparently, these only appeared in R<2.1) [CTB] - plot.network was failing on networks where is.bipartite==TRUE [CTB] Changes: - The generic form of %c% was temporarily removed, to avoid namespace issues with sna. (This will be rectified in future releases.) [CTB] v1.0 New Functions, New Features, Changes, and Bug Fixes New Functions: - Operator overloading for +, -, *, |, &, and ! have been added, as has the composition operator, %c% [CTB] - Operator overloading is now supported for "[" and "[<-"; this allows network objects to be treated transparently as if they were adjacency matrices (in some cases, at least). New extraction/replacement operators %n%, %n%<-, %v%, %v%<- have been added for extracting/assigning values to network and vertex attributes (respectively) [CTB] - network.copy: returns a copy of the input network [CTB] - network.dyadcount: return the number of dyads in a network (optionally adjusting for the missing dyads) [MSH] New Features: - add.edges now checks for illegal loop-like edges when edge.check==TRUE [CTB] - get.neighborhood now allows users to specify whether missing edges should be ignored [CTB] - set.edge.value now accepts edge values in vector format [CTB] Changes: - All access access functions now modify their arguments in place; this greatly improves performance, but may produce unexpected behavior. If users wish to generate a modified copy of a network, they must first generate the copy and then modify it. Otherwise, the old object will be modified as well. In accordance with this, modification methods now return their (modified) arguments invisibly. [CTB] - Most access functions have now been backended; this has improved the performance of many operations by as much as two orders of magnitude [CTB] - get.edges and get.edgeIDs now treat all undirected networks as if called with neighborhood=="combined" [CTB] - as.matrix.network.incidence now handles undirected edges in a more conventional way [CTB] - network.adjacency will now ignore diagonal entries if has.loops=FALSE [CTB] Bug Fixes: - as.network.edgelist and as.network.incidence were producing spurious edge attributes [CTB] - list.edge.attributes generated failed under certain conditions (submitted by Matthew Wiener) [CTB] - set.edge.attribute was able to write attributes into non-existent (NULL) edges [CTB] - set.edge.value could exhibit strange behavior when carelessly chosen edge subsets were selected [CTB] v0.5-4 New Facilities for Bipartite, New Features, Changes, and Bug Fixes New Functions: - network.bipartite to store an explicit bipartite network. Modified network.initialize, etc, to accept "bipartite" argument. [MSH] - is.bipartite: logical test for a bipartite network [MSH] - read.paj: read one or more network objects from a Pajek file [MSH, DS] New Features: - summary.network now reports on edge attributes [MSH] Changes: - The composition operator (%c%) has been removed due to a name conflict with the sna package; since sna now supports network objects, its version can be used instead. [CTB] - as.sociomatrix is now properly configured to work in tandem with as.sociomatrix.sna (in the sna package). The functionality of the routine has also been extended slightly. [CTB] Bug Fixes: - .First.lib: Print out correct welcome banner for package [MSH] - Fix displayisolates determination in plot.network.default [MSH] v0.5-3 New Functions, New Data Set, and Changes New Functions: - permute.vertexIDs: Permute vertices in their internal representation [CTB] New Data: - emon: Drabek et al.'s Emergent Multi-organizational Networks [CTB] Changes: - The obsolete examples directory has been removed. [CTB] v0.5-2 New Features, New Functions and Bug Fixes New Functions: - delete.vertices: Remove one or more vertices (and associated edges) from a network object. - delete.edge.attribute, delete.network.attribute, delete.vertex attribute: Remove an edge/network/vertex attribute. - list.edge.attributes, list.network.attributes, list.vertex attributes: List all edge/network/vertex attribute names. New Features: - plot.graph.default now accepts vertex/edge attribute names for most vertex/edge display properties. Bug Fixes: - Edge deletion produced exciting and unexpected behavior in some cases. - network.initialize set vertex na attributes to TRUE by default. network/README.md0000644000176200001440000000456514057014734013241 0ustar liggesusers# `network`: Classes for Relational Data [![rstudio mirror downloads](https://cranlogs.r-pkg.org/badges/network?color=2ED968)](https://cranlogs.r-pkg.org/) [![cran version](https://www.r-pkg.org/badges/version/network)](https://cran.r-project.org/package=network) [![Coverage status](https://codecov.io/gh/statnet/network/branch/master/graph/badge.svg)](https://codecov.io/github/statnet/network?branch=master) [![R build status](https://github.com/statnet/network/workflows/R-CMD-check/badge.svg)](https://github.com/statnet/network/actions) Tools to create and modify network objects. The network class can represent a range of relational data types, and supports arbitrary vertex/edge/graph attributes. ## Public and Private repositories To facilitate open development of the package while giving the core developers an opportunity to publish on their developments before opening them up for general use, this project comprises two repositories: * A public repository `statnet/network` * A private repository `statnet/network-private` The intention is that all developments in `statnet/network-private` will eventually make their way into `statnet/network` and onto CRAN. Developers and Contributing Users to the Statnet Project should read https://statnet.github.io/private/ for information about the relationship between the public and the private repository and the workflows involved. ## Latest Windows and MacOS binaries A set of binaries is built after every commit to the repository. We strongly encourage testing against them before filing a bug report, as they may contain fixes that have not yet been sent to CRAN. They can be downloaded through the following links: * [MacOS binary (a `.tgz` file in a `.zip` file)](https://nightly.link/statnet/network/workflows/R-CMD-check.yaml/master/macOS-rrelease-binaries.zip) * [Windows binary (a `.zip` file in a `.zip` file)](https://nightly.link/statnet/network/workflows/R-CMD-check.yaml/master/Windows-rrelease-binaries.zip) You will need to extract the MacOS `.tgz` or the Windows `.zip` file from the outer `.zip` file before installing. These binaries are usually built under the latest version of R and their operating system and may not work under other versions. You may also want to install the corresponding latest binaries for packages on which `network` depends, in particular [`statnet.common`](https://github.com/statnet/statnet.common). network/data/0000755000176200001440000000000013357022000012644 5ustar liggesusersnetwork/data/flo.RData0000644000176200001440000000051013357022000014335 0ustar liggesusers7zXZi"6!X  ])TW"nRʟXN7#&'ƯNJaad 7YU5z_^,+V:x<:Yunsvؿ͍CT]ՠX]$D>/EdǼbq6{5H6##^)*s.;Q'haj繏>Oho8/I/ 7jEZ3u5.͎@&@3>nΜaY\^5Ui"2%)fYOܗ,@>0 YZnetwork/data/emon.RData0000644000176200001440000001601113357022000014516 0ustar liggesusersBZh91AY&SY( C14f0 @HAii%=Ԟwp#Tm(lw;̀P4:ǟ8>X24wɷphBMdzOSO =HSA@%444h&a @ iJjh44 2 P i4!)!H@DR&SLOT5'ꟊ{TfFmF4hyAz$&LSA<1&2CO)LzFP=@@2 I?FS 'i$&H jΪM(2cj,` 2b`ѧRhUE1e j6+X+qC5dثZv%暿@`ER\n-IPd4BHdRE5s40].bؽlR K(#ȋΕKN\10Iki4( |T3=ԃ}#TU_XZĜ=0$ (LT]< Fτ%,YPes(Vt?Ve09 ":LuVCBM63>N^R]n~cX;? SKjFזLT:;:x2pXjrZ'LgX,r1(\w \p9_(;<_ކ)Ի{{9V%^;#$!9|0'"/T0@\i ٹΆCϾ灵vGw2G2ӞQ\z^Ǵ%h}^O>H|qLnpn?oyoot'"Ai^{J(=;.VDHdI0X Zž2Zo6;vXqcddfUF!ZUV(T)TQɤp[i-ڋcxسzP4ii4 fQ-ݮT 92ĜRd@Ql)xI5e2mg9R9Z劢DLR2+R [V+om+J|ϧ8GbB[oЯ$>gZ ȕ+\!62_wG֩R|Q§)7P<&bZV{ïE4m0;%S1Z&x4]kp%N'906,մa>CjqYۭ:RiLA շv(}Ӓ4YJYCHXŽV^j !&]z [AQ+ֽ㱋q3gj]@ObJw]RСNK(P, I R@$@")BJ HwD!T[7>؊- *yxA{R-P BPJB((ҥR% #"DEW  C>@.a[6\]n*%n^ R-TjGub@P4A#-֔`/~y^E-m[.(@ D| @ႁS8P" `P"r`aP!!P6"x0{;xܾ׸t$dZ KY-*LӁl{h-fgB$V᠊-alf"vM%aL+ I,4XBF2Y T.RaǎFha Z*,/8=;@<ʽY Dg(el2,WA4TP*()Ud*αtfP'֊9D1&]Mef-) lKjCYP ZZD@Rn([Fs Ul۷yz>RnPM 2׿r8Xu^N9\dD~^Dj47J O.1=5nC bX@IcTaʂr$#]hh1'軽x匰NI,-Ĭ)D\d5hT |TP:>0yr2av+ t&*E^AD썀ATb#""(oz :M&\ ܊iLDQX(:B9 H'A@@Аmd#l( 77w @!(@G*>J*#I7@TTqHF-$G A - H#BP%RP!@%(҅Rҥ"!@ R(R%RЫQGUEDA4HcQEMw#UETT%-b"*K룗 AVA t tK@D%PQJD JPPAIDTDR@д% D2QPҍ ERT5TTHIB+MP4!2(P%M MŲ.Q72 Hfe{t\؋m3!MBnGZA"w;1DsaeR B `) *4"7{Q,hB<:9.mftJvDЙF.(eR1 c@(n"``ЉN(RlJ +D.AjaTvazB2Jl8&cÓ3pnhn=tp먇Mnܵ\7#3ّ 44m߆j67!A+Ftskl\Æ)jĚ96uQsVjyspTW̢Dpv;5 H@dQ-3.)"r{x띀PCmꦊ)P&fG=qJJ@e&Y?1>-AwoCQw਀%&PW(iPȥ\8"STS>$gۓڠ?hAh+NʼWK9tFGўf !JԶJXqXZXŐiHT+mQ /`.@s"= WHd9:Rr:B @iją`^kZ5&X% /Bma)h$Gh5EfZ o 'D3PSܮ1ܝE%Lx%fZ*e ! "dz󆣼ez9D7@EC!ߙJQ#텂Gnk(=TL *Ӫ}' n{ߤ `PP(N /hcz_ 2U bX| _o2xR :Mʪ@5?vf[ "I BFy;uy< xvF򦋥+ſ1^p~>A &vu@~DF~`UfBH +zR (w)OSp ߂N$=j;z:{.3E?7^]_7^Ĝ@$G P)ҭ6|]~<׹n_@=hOI|C R mFJO>f dr? _[x:. ߷ʚk߷܊}ސt1(Ga ҟBhX;PbߗD"DOvN!`P;Tɀp?ërExAvy׈B;K8C( %YPP()s\K :_A2!QU(T!1klKd  =TU:֢*Djc X7Kٮ B0Lqj pp ^W WVkm)Iðr/GF6iMh'&Gz\Ԅ/(rNo9ƣowCvn `CZ<ޡ/~8g>T<]KuTXݻqp!Fp[22RycP:`_&'o0 @r `GLlr(KQ,qy80 c[/9/wi^o6mD6xzE@NLͥ`I=@c P4w׌FP |_ǩci˹|2* CA>o'8(astCl<@`iԹBUpBR%7hCx8 ,@ eAAҨ6S{nȬ]4ST 0|ֆ9 BӧǎO::Ba stէE|+}:tre UVv!\ Cx(l @cjb5!ֺ(+nʓi| :-z7@E3ʋuD/Rip  w>p!-Ar ϯ ӏǾeJ""aPV A1^&jTB(iR#y%(G yǠή>!= 4#kX#"cоD0*X"׶hۋ :5i VLǒ8dzEeO:ʖƼYUOXc y'H莗`4m'7 I)0NY;hdwUœYTnokeU| LG{£s.[y5;] hX- Tˤ[xg6f)2Cƶn;i*{BPEbUGZ~U9.}thp =.nƛ)!m&kb֞CO,vJ +' ZOjPv%@U%<`5jV H@(@r$&d+x[<;p_.:c; xݚx;^),IM@ ;V2Z(&B =aH network/man/0000755000176200001440000000000014057075374012532 5ustar liggesusersnetwork/man/network.layout.Rd0000644000176200001440000001574714057075374016044 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{network.layout} \alias{network.layout} \alias{network.layout.circle} \alias{network.layout.fruchtermanreingold} \alias{network.layout.kamadakawai} \title{Vertex Layout Functions for plot.network} \usage{ network.layout.circle(nw, layout.par) network.layout.fruchtermanreingold(nw, layout.par) network.layout.kamadakawai(nw, layout.par) } \arguments{ \item{nw}{a network object, as passed by \code{\link{plot.network}}.} \item{layout.par}{a list of parameters.} } \value{ A matrix whose rows contain the x,y coordinates of the vertices of \code{d}. } \description{ Various functions which generate vertex layouts for the \code{\link{plot.network}} visualization routine. } \details{ Vertex layouts for network visualization pose a difficult problem -- there is no single, ``good'' layout algorithm, and many different approaches may be valuable under different circumstances. With this in mind, \code{\link{plot.network}} allows for the use of arbitrary vertex layout algorithms via the \code{network.layout.*} family of routines. When called, \code{\link{plot.network}} searches for a \code{network.layout} function whose fourth name matches its \code{mode} argument (see \code{\link{plot.network}} help for more information); this function is then used to generate the layout for the resulting plot. In addition to the routines documented here, users may add their own layout functions as needed. The requirements for a \code{network.layout} function are as follows: \enumerate{ \item the first argument, \code{nw}, must be a network object; \item the second argument, \code{layout.par}, must be a list of parameters (or \code{NULL}, if no parameters are specified); and \item the return value must be a real matrix of dimension \code{c(2,network.size(nw))}, whose rows contain the vertex coordinates. } Other than this, anything goes. (In particular, note that \code{layout.par} could be used to pass additional matrices or other information, if needed. Alternately, it is possible to make layout methods that respond to covariates on the network object, which are maintained intact by plot.network.) The \code{network.layout} functions currently supplied by default are as follows (with \code{n==network.size(nw)}): \describe{ \item{circle}{ This function places vertices uniformly in a circle; it takes no arguments.} \item{fruchtermanreingold}{ This function generates a layout using a variant of Fruchterman and Reingold's force-directed placement algorithm. It takes the following arguments: \describe{ \item{layout.par$niter}{ This argument controls the number of iterations to be employed. Larger values take longer, but will provide a more refined layout. (Defaults to 500.) } \item{layout.par$max.delta}{ Sets the maximum change in position for any given iteration. (Defaults to \code{n}.)} \item{layout.par$area}{ Sets the "area" parameter for the F-R algorithm. (Defaults to \code{n^2}.)} \item{layout.par$cool.exp}{ Sets the cooling exponent for the annealer. (Defaults to 3.)} \item{layout.par$repulse.rad}{ Determines the radius at which vertex-vertex repulsion cancels out attraction of adjacent vertices. (Defaults to \code{area*log(n)}.)} \item{layout.par$ncell}{ To speed calculations on large graphs, the plot region is divided at each iteration into \code{ncell} by \code{ncell} \dQuote{cells}, which are used to define neighborhoods for force calculation. Moderate numbers of cells result in fastest performance; too few cells (down to 1, which produces \dQuote{pure} F-R results) can yield odd layouts, while too many will result in long layout times. (Defaults to \code{n^0.4}.)} \item{layout.par$cell.jitter}{ Jitter factor (in units of cell width) used in assigning vertices to cells. Small values may generate \dQuote{grid-like} anomalies for graphs with many isolates. (Defaults to \code{0.5}.)} \item{layout.par$cell.pointpointrad}{ Squared \dQuote{radius} (in units of cells) such that exact point interaction calculations are used for all vertices belonging to any two cells less than or equal to this distance apart. Higher values approximate the true F-R solution, but increase computational cost. (Defaults to \code{0}.)} \item{layout.par$cell.pointcellrad}{ Squared \dQuote{radius} (in units of cells) such that approximate point/cell interaction calculations are used for all vertices belonging to any two cells less than or equal to this distance apart (and not within the point/point radius). Higher values provide somewhat better approximations to the true F-R solution at slightly increased computational cost. (Defaults to \code{18}.)} \item{layout.par$cell.cellcellrad}{ Squared \dQuote{radius} (in units of cells) such that approximate cell/cell interaction calculations are used for all vertices belonging to any two cells less than or equal to this distance apart (and not within the point/point or point/cell radii). Higher values provide somewhat better approximations to the true F-R solution at slightly increased computational cost. Note that cells beyond this radius (if any) do not interact, save through edge attraction. (Defaults to \code{ncell^2}.)} \item{layout.par$seed.coord}{ A two-column matrix of initial vertex coordinates. (Defaults to a random circular layout.) } } } \item{kamadakawai}{ This function generates a vertex layout using a version of the Kamada-Kawai force-directed placement algorithm. It takes the following arguments: \describe{ \item{layout.par$niter}{ This argument controls the number of iterations to be employed. (Defaults to 1000.) } \item{layout.par$sigma}{ Sets the base standard deviation of position change proposals. (Defaults to \code{n/4}.)} \item{layout.par$initemp}{ Sets the initial "temperature" for the annealing algorithm. (Defaults to 10.)} \item{layout.par$cool.exp}{ Sets the cooling exponent for the annealer. (Defaults to 0.99.)} \item{layout.par$kkconst}{ Sets the Kamada-Kawai vertex attraction constant. (Defaults to \code{n)^2}.)} \item{layout.par$elen}{ Provides the matrix of interpoint distances to be approximated. (Defaults to the geodesic distances of \code{nw} after symmetrizing, capped at \code{sqrt(n)}.)} \item{layout.par$seed.coord}{ A two-column matrix of initial vertex coordinates. (Defaults to a gaussian layout.) } } } } } \note{ The \code{network.layout} routines shown here are adapted directly from the \code{\link[sna]{gplot.layout}} routines of the \code{sna} package. } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} Fruchterman, T.M.J. and Reingold, E.M. (1991). \dQuote{Graph Drawing by Force-directed Placement.} \emph{Software - Practice and Experience,} 21(11):1129-1164. Kamada, T. and Kawai, S. (1989). \dQuote{An Algorithm for Drawing General Undirected Graphs.} \emph{Information Processing Letters,} 31(1):7-15. } \seealso{ \code{\link{plot.network}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{dplot} \keyword{graphs} network/man/get.neighborhood.Rd0000644000176200001440000000302214057075374016243 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{get.neighborhood} \alias{get.neighborhood} \title{Obtain the Neighborhood of a Given Vertex} \usage{ get.neighborhood(x, v, type = c("out", "in", "combined"), na.omit = TRUE) } \arguments{ \item{x}{an object of class \code{network}} \item{v}{a vertex ID} \item{type}{the neighborhood to be computed} \item{na.omit}{logical; should missing edges be ignored when obtaining vertex neighborhoods?} } \value{ A vector containing the vertex IDs for the chosen neighborhood. } \description{ \code{get.neighborhood} returns the IDs of all vertices belonging to the in, out, or combined neighborhoods of \code{v} within network \code{x}. } \details{ Note that the combined neighborhood is the union of the in and out neighborhoods -- as such, no vertex will appear twice. } \examples{ #Create a network with three edges m<-matrix(0,3,3) m[1,2]<-1; m[2,3]<-1; m[3,1]<-1 g<-network(m) #Examine the neighborhood of vertex 1 get.neighborhood(g,1,"out") get.neighborhood(g,1,"in") get.neighborhood(g,1,"combined") } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} Wasserman, S. and Faust, K. 1994. \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. } \seealso{ \code{\link{get.edges}}, \code{\link{is.adjacent}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{graphs} network/man/valid.eids.Rd0000644000176200001440000000223213566403644015041 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{valid.eids} \alias{valid.eids} \title{Get the ids of all the edges that are valid in a network} \usage{ valid.eids(x) } \arguments{ \item{x}{a network object, possibly with some deleted edges.} } \value{ a vector of integer ids corresponding to the non-null edges in x } \description{ Returns a vector of valid edge ids (corresponding to non-NULL edges) for a network that may have some deleted edges. } \details{ The edge ids used in the network package are positional indices on the internal "mel" list. When edges are removed using \code{\link{delete.edges}} \code{NULL} elements are left on the list. The function \code{valid.eids} returns the ids of all the valid (non-null) edge ids for its \code{network} argument. } \note{ If it is known that x has no deleted edges, \code{seq_along(x$mel)} is a faster way to generate the sequence of possible edge ids. } \examples{ net<-network.initialize(100) add.edges(net,1:99,2:100) delete.edges(net,eid=5:95) # get the ids of the non-deleted edges valid.eids(net) } \seealso{ See also \code{\link{delete.edges}} } \author{ skyebend } network/man/permute.vertexIDs.Rd0000644000176200001440000000335714057075374016426 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{permute.vertexIDs} \alias{permute.vertexIDs} \title{Permute (Relabel) the Vertices Within a Network} \usage{ permute.vertexIDs(x, vids) } \arguments{ \item{x}{an object of class \code{\link{network}}.} \item{vids}{a vector of vertex IDs, in the order to which they are to be permuted.} } \value{ Invisibly, a pointer to the permuted network. \code{permute.vertexIDs} modifies its argument in place. } \description{ \code{permute.vertexIDs} permutes the vertices within a given network in the specified fashion. Since this occurs internally (at the level of vertex IDs), it is rarely of interest to end-users. } \details{ \code{permute.vertexIDs} alters the internal ordering of vertices within a \code{\link{network}}. For most practical applications, this should not be necessary -- de facto permutation can be accomplished by altering the appropriate vertex attributes. \code{permute.vertexIDs} is needed for certain other routines (such as \code{\link{delete.vertices}}), where it is used in various arcane and ineffable ways. } \examples{ data(flo) #Load the Florentine Families data nflo<-network(flo) #Create a network object n<-network.size(nflo) #Get the number of vertices permute.vertexIDs(nflo,n:1) #Reverse the vertices all(flo[n:1,n:1]==as.sociomatrix(nflo)) #Should be TRUE } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{network}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{graphs} \keyword{manip} network/man/network-internal.Rd0000644000176200001440000000137313737227152016325 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.R, R/operators.R \name{network-internal} \alias{network-internal} \alias{is.discrete.numeric} \alias{is.discrete.character} \alias{is.discrete} \alias{networkOperatorSetup} \title{Internal Network Package Functions} \usage{ is.discrete.numeric(x) is.discrete.character(x) is.discrete(x) networkOperatorSetup(x, y = NULL) } \arguments{ \item{x}{an object to be designated either discrete or continuous, or a network.} \item{y}{a network or something coercible to one.} \item{\dots}{further arguments passed to or used by methods.} } \description{ Internal network functions. } \details{ Most of these are not to be called by the user. } \seealso{ network } \keyword{internal} network/man/is.adjacent.Rd0000644000176200001440000000577414057075374015221 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{is.adjacent} \alias{is.adjacent} \title{Determine Whether Two Vertices Are Adjacent} \usage{ is.adjacent(x, vi, vj, na.omit = FALSE) } \arguments{ \item{x}{an object of class \code{network}} \item{vi}{a vertex ID} \item{vj}{a second vertex ID} \item{na.omit}{logical; should missing edges be ignored when assessing adjacency?} } \value{ A logical, giving the status of the (i,j) edge } \description{ \code{is.adjacent} returns \code{TRUE} iff \code{vi} is adjacent to \code{vj} in \code{x}. Missing edges may be omitted or not, as per \code{na.omit}. } \details{ Vertex \eqn{v} is said to be adjacent to vertex \eqn{v'} within directed network \eqn{G} iff there exists some edge whose tail set contains \eqn{v} and whose head set contains \eqn{v'}. In the undirected case, head and tail sets are exchangeable, and thus \eqn{v} is adjacent to \eqn{v'} if there exists an edge such that \eqn{v} belongs to one endpoint set and \eqn{v'} belongs to the other. (In dyadic graphs, these sets are of cardinality 1, but this may not be the case where hyperedges are admitted.) If an edge which would make \eqn{v} and \eqn{v'} adjacent is marked as missing (via its \code{na} attribute), then the behavior of \code{is.adjacent} depends upon \code{na.omit}. If \code{na.omit==FALSE} (the default), then the return value is considered to be \code{NA} unless there is also \emph{another} edge from \eqn{v} to \eqn{v'} which is \emph{not} missing (in which case the two are clearly adjacent). If \code{na.omit==TRUE}, on the other hand the missing edge is simply disregarded in assessing adjacency (i.e., it effectively treated as not present). It is important not to confuse \dQuote{not present} with \dQuote{missing} in this context: the former indicates that the edge in question does not belong to the network, while the latter indicates that the state of the corresponding edge is regarded as unknown. By default, all edge states are assumed \dQuote{known} unless otherwise indicated (by setting the edge's \code{na} attribute to \code{TRUE}; see \code{\link{attribute.methods}}). Adjacency can also be determined via the extraction/replacement operators. See the associated man page for details. } \note{ Prior to version 1.4, \code{na.omit} was set to \code{TRUE} by default. } \examples{ #Create a very simple graph g<-network.initialize(3) add.edge(g,1,2) is.adjacent(g,1,2) #TRUE is.adjacent(g,2,1) #FALSE g[1,2]==1 #TRUE g[2,1]==1 #FALSE } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} Wasserman, S. and Faust, K. 1994. \emph{Social Network Analysis: Methods and Applications}. Cambridge: Cambridge University Press. } \seealso{ \code{\link{get.neighborhood}}, \code{\link{network.extraction}}, \code{\link{attribute.methods}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{graphs} network/man/add.edges.Rd0000644000176200001440000000717614057075374014652 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{add.edges} \alias{add.edges} \alias{add.edge} \alias{add.edges.network} \alias{add.edge.network} \title{Add Edges to a Network Object} \usage{ add.edge( x, tail, head, names.eval = NULL, vals.eval = NULL, edge.check = FALSE, ... ) add.edges(x, tail, head, names.eval = NULL, vals.eval = NULL, ...) } \arguments{ \item{x}{an object of class \code{network}} \item{tail}{for \code{add.edge}, a vector of vertex IDs reflecting the tail set for the edge to be added; for \code{add.edges}, a list of such vectors} \item{head}{for \code{add.edge}, a vector of vertex IDs reflecting the head set for the edge to be added; for \code{add.edges}, a list of such vectors} \item{names.eval}{for \code{add.edge}, an optional list of names for edge attributes; for \code{add.edges}, a list of length equal to the number of edges, with each element containing a list of names for the attributes of the corresponding edge} \item{vals.eval}{for \code{add.edge}, an optional list of edge attribute values (matching \code{names.eval}); for \code{add.edges}, a list of such lists} \item{edge.check}{logical; should we perform (computationally expensive) tests to check for the legality of submitted edges?} \item{...}{additional arguments} } \value{ Invisibly, \code{add.edge} and \code{add.edges} return pointers to their modified arguments; both functions modify their arguments in place.. } \description{ Add one or more edges to an existing network object. } \details{ The edge checking procedure is very slow, but should always be employed when debugging; without it, one cannot guarantee that the network state is consistent with network level variables (see \code{\link{network.indicators}}). For example, by default it is possible to add multiple edges to a pair of vertices. Edges can also be added/removed via the extraction/replacement operators. See the associated man page for details. } \note{ \code{add.edges} and \code{add.edge} were converted to an S3 generic funtions in version 1.9, so they actually call \code{add.edges.network} and \code{add.edge.network} by default, and may call other versions depending on context (i.e. when called with a \code{networkDynamic} object). } \examples{ #Initialize a small, empty network g<-network.initialize(3) #Add an edge add.edge(g,1,2) g #Can also add edges using the extraction/replacement operators #note that replacement operators are much slower than add.edges() g[,3]<-1 g[,] #Add multiple edges with attributes to a network # pretend we just loaded in this data.frame from a file # Note: network.edgelist() may be simpler for this case elData<-data.frame( from_id=c("1","2","3","1","3","1","2"), to_id=c("1", "1", "1", "2", "2", "3", "3"), myEdgeWeight=c(1, 2, 1, 2, 5, 3, 9.5), someLetters=c("B", "W", "L", "Z", "P", "Q", "E"), edgeCols=c("red","green","blue","orange","pink","brown","gray"), stringsAsFactors=FALSE ) valueNet<-network.initialize(3,loops=TRUE) add.edges(valueNet,elData[,1],elData[,2], names.eval=rep(list(list("myEdgeWeight","someLetters","edgeCols")),nrow(elData)), vals.eval=lapply(1:nrow(elData),function(r){as.list(elData[r,3:5])})) list.edge.attributes(valueNet) } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{network}}, \code{\link{add.vertices}}, \code{\link{network.extraction}}, \code{\link{delete.edges}}, \code{\link{network.edgelist}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{classes} \keyword{graphs} network/man/deletion.methods.Rd0000644000176200001440000000463514057075374016276 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{deletion.methods} \alias{deletion.methods} \alias{delete.edges} \alias{delete.vertices} \title{Remove Elements from a Network Object} \usage{ delete.edges(x, eid) delete.vertices(x, vid) } \arguments{ \item{x}{an object of class \code{network}.} \item{eid}{a vector of edge IDs.} \item{vid}{a vector of vertex IDs.} } \value{ Invisibly, a pointer to the updated network; these functions modify their arguments in place. } \description{ \code{delete.edges} removes one or more edges (specified by their internal ID numbers) from a network; \code{delete.vertices} performs the same task for vertices (removing all associated edges in the process). } \details{ Note that an edge's ID number corresponds to its order within \code{x$mel}. To determine edge IDs, see \code{\link{get.edgeIDs}}. Likewise, vertex ID numbers reflect the order with which vertices are listed internally (e.g., the order of \code{x$oel} and \code{x$iel}, or that used by \code{as.matrix.network.adjacency}). When vertices are removed from a network, all edges having those vertices as endpoints are removed as well. When edges are removed, the remaining edge ids are NOT permuted and \code{NULL} elements will be left on the list of edges, which may complicate some functions that require eids (such as \code{\link{set.edge.attribute}}). The function \code{\link{valid.eids}} provides a means to determine the set of valid (non-NULL) edge ids. Edges can also be added/removed via the extraction/replacement operators. See the associated man page for details. } \examples{ #Create a network with three edges m<-matrix(0,3,3) m[1,2]<-1; m[2,3]<-1; m[3,1]<-1 g<-network(m) as.matrix.network(g) delete.edges(g,2) #Remove an edge as.matrix.network(g) delete.vertices(g,2) #Remove a vertex as.matrix.network(g) #Can also remove edges using extraction/replacement operators g<-network(m) g[1,2]<-0 #Remove an edge g[,] g[,]<-0 #Remove all edges g[,] } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{get.edgeIDs}}, \code{\link{network.extraction}}, \code{\link{valid.eids}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{classes} \keyword{graphs} network/man/preparePlotArgs.Rd0000644000176200001440000000450113566403644016132 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.R \name{plotArgs.network} \alias{plotArgs.network} \title{Expand and transform attributes of networks to values appropriate for aguments to plot.network} \usage{ plotArgs.network(x, argName, argValue, d = NULL, edgetouse = NULL) } \arguments{ \item{x}{a \code{network} object which is going to be plotted} \item{argName}{character, the name of \code{plot.network} graphic parameter} \item{argValue}{value for the graphic paramter named in \code{argName} which to be transformed/prepared. For many attributes, if this is a single character vector it will be assumed to be the name of a vertex or edge attribute to be extracted and transformed} \item{d}{is an edgelist matrix of edge values optionally used by some edge attribute functions} \item{edgetouse}{numeric vector giving set of edge ids to be used (in case some edges are not being shown) required by some attributes} } \value{ returns a vector with length corresponding to the number of vertices or edges (depending on the paramter type) giving the appropriately prepared values for the parameter type. If the values or specified attribute can not be processed correctly, and Error may occur. } \description{ This is primairly an internal function called by \code{plot.network} or by external packages such as \code{ndtv} that want to prepare \code{plot.network} graphic arguments in a standardized way. } \details{ Given a network object, the name of graphic parameter argument to \code{plot.network} and value, it will if necessary transform the value, or extract it from the network, according to the description in \code{\link{plot.network}}. For some attributes, if the value is the name of a vertex or edge attribute, the appropriate values will be extracted from the network before transformation. } \examples{ net<-network.initialize(3) set.vertex.attribute(net,'color',c('red','green','blue')) set.vertex.attribute(net,'charm',1:3) # replicate a single colorname value plotArgs.network(net,'vertex.col','purple') # map the 'color' attribute to color plotArgs.network(net,'vertex.col','color') # similarly for a numeric attribute ... plotArgs.network(net,'vertex.cex',12) plotArgs.network(net,'vertex.cex','charm') } \seealso{ See also \code{\link{plot.network}} } \author{ skyebend@uw.edu } network/man/as.sociomatrix.Rd0000644000176200001440000000613114057075374015765 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/coercion.R \name{as.sociomatrix} \alias{as.sociomatrix} \title{Coerce One or More Networks to Sociomatrix Form} \usage{ as.sociomatrix( x, attrname = NULL, simplify = TRUE, expand.bipartite = FALSE, ... ) } \arguments{ \item{x}{an adjacency matrix, array, \code{\link{network}} object, or list thereof.} \item{attrname}{optionally, the name of a network attribute to use for extracting edge values (if \code{x} is a \code{\link{network}} object).} \item{simplify}{logical; should \code{as.sociomatrix} attempt to combine its inputs into an adjacency array (\code{TRUE}), or return them as separate list elements (\code{FALSE})?} \item{expand.bipartite}{logical; if \code{x} is bipartite, should we return the full adjacency matrix (rather than the abbreviated, two-mode form)?} \item{...}{additional arguments for the coercion routine.} } \value{ One or more adjacency matrices. If all matrices are of the same dimension and \code{simplify==TRUE}, the matrices are joined into a single array; otherwise, the return value is a list of single adjacency matrices. } \description{ \code{as.sociomatrix} takes adjacency matrices, adjacency arrays, \code{\link{network}} objects, or lists thereof, and returns one or more sociomatrices (adjacency matrices) as appropriate. This routine provides a useful input-agnostic front-end to functions which process adjacency matrices. } \details{ \code{as.sociomatrix} provides a more general means of coercing input into adjacency matrix form than \code{\link{as.matrix.network}}. In particular, \code{as.sociomatrix} will attempt to coerce all input networks into the appropriate form, and return the resulting matrices in a regularized manner. If \code{simplify==TRUE}, \code{as.sociomatrix} attempts to return the matrices as a single adjacency array. If the input networks are of variable size, or if \code{simplify==FALSE}, the networks in question are returned as a list of matrices. In any event, a single input network is always returned as a lone matrix. If \code{attrname} is given, the specified edge attribute is used to extract edge values from any \code{\link{network}} objects contained in \code{x}. Note that the same attribute will be used for all networks; if no attribute is specified, the standard dichotomous default will be used instead. } \examples{ #Generate an adjacency array g<-array(rbinom(100,1,0.5),dim=c(4,5,5)) #Generate a network object net<-network(matrix(rbinom(36,1,0.5),6,6)) #Coerce to adjacency matrix form using as.sociomatrix as.sociomatrix(g,simplify=TRUE) #Returns as-is as.sociomatrix(g,simplify=FALSE) #Returns as list as.sociomatrix(net) #Coerces to matrix as.sociomatrix(list(net,g)) #Returns as list of matrices } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{as.matrix.network}}, \code{\link{network}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{graphs} \keyword{manip} network/man/as.color.Rd0000644000176200001440000000420214057014734014530 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.R \name{as.color} \alias{as.color} \alias{is.color} \title{Transform vector of values into color specification} \usage{ as.color(x, opacity = 1) is.color(x) } \arguments{ \item{x}{vector of numeric, character or factor values to be transformed} \item{opacity}{optional numeric value in the range 0.0 to 1.0 used to specify the opacity/transparency (alpha) of the colors to be returned. 0 means fully opaque, 1 means fully transparent. Behavior of \code{as.color} is as follows: \itemize{ \item integer numeric values: unchanged, (assumed to corespond to values of R's active \code{\link{palette}}) \item integer real values: will be translated to into grayscale values ranging between the max and min \item factor: integer values corresponding to factor levels will be used \item character: if values are valid colors (as determined by \code{is.color}) they will be returned as is. Otherwise converted to factor and numeric value of factor returned. } The optional \code{opacity} parameter can be used to make colors partially transparent (as a shortcut for \code{\link{adjustcolor}}. If used, colors will be returned as hex rgb color string (i.e. \code{"#00FF0080"}) The \code{is.color} function checks if each character element of \code{x} appears to be a color name by comparing it to \code{\link{colors}} and checking if it is an HTML-style hex color code. Note that it will return FALSE for integer values. These functions are used for the color parameters of \code{\link{plot.network}}.} } \value{ For \code{as.color}, a vector integer values (corresponding to color palette values) or character color name. For \code{is.color}, a logical vector indicating if each element of x appears to be a color \code{as.color()} returns TRUE if x is a character in a known color format. } \description{ Convenience function to convert a vector of values into a color specification. } \examples{ as.color(1:3) as.color(c('a','b','c')) # add some transparency as.color(c('red','green','blue'),0.5) # gives "#FF000080", "#00FF0080", "#0000FF80" is.color(c('red',1,'foo',NA,'#FFFFFF55')) } network/man/loading.attributes.Rd0000644000176200001440000001566414057075374016637 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/network-package.R \name{loading.attributes} \alias{loading.attributes} \title{Examples of how to load vertex and edge attributes into networks} \description{ Additional examples of how to manipulate network attributes using the functions documented in \code{\link{attribute.methods}} } \details{ The \code{\link{attribute.methods}} documentation gives details about the use of the specific network attribute methods such as \code{get.vertex.attribute} and \code{set.edge.attribute}. This document gives examples of how to load in and attach attribute data, drawing heavily on material from the Sunbelt statnet workshops \url{https://github.com/statnet/Workshops/wiki}. The examples section below give a quick overview of: \itemize{ \item Loading in a matrix \item Attaching vertex attributes \item Attaching edge atributes from a matrix \item Loading in an edgelist \item Attaching edge atributes from an edgelist } The \code{\link{read.table}} documentation provides more information about reading data in from various tabular file formats prior to loading into a network. Note that the output is usually a \code{\link{data.frame}} object in which each columns is represented as a \code{\link{factor}}. This means that in some cases when the output is directly loaded into a network the variable values will appear as factor level numbers instead of text values. The \code{stringsAsFactors=FALSE} flag may help with this, but some columns may need to be converted using \code{as.numeric} or \code{as.character} where appropriate. } \examples{ # read in a relational data adjacency matrix # LOADING IN A MATRIX \dontrun{ # can download matrix file from # https://statnet.csde.washington.edu/trac/raw-attachment/wiki/Resources/relationalData.csv # and download vertex attribute file from # https://statnet.csde.washington.edu/trac/raw-attachment/wiki/Resources/vertexAttributes.csv # load in relation matrix from file relations <- read.csv("relationalData.csv",header=FALSE,stringsAsFactors=FALSE) # convert to matrix format from data frame relations <- as.matrix(relations) # load in vertex attributes nodeInfo <- read.csv("vertexAttributes.csv",header=TRUE,stringsAsFactors=FALSE) } \dontshow{ # since no access to file, creating it here relations <- matrix( c(0,0,0,1,1,1,0,0,0, 0,0,0,0,0,1,0,0,0, 0,0,0,0,0,0,1,0,1, 1,0,0,0,1,0,0,0,0, 1,0,0,1,0,0,0,0,0, 1,1,0,0,0,0,0,0,1, 0,0,1,0,0,0,0,0,1, 0,0,0,0,0,0,0,0,0, 0,0,1,0,0,1,1,0,0),ncol=9,byrow=TRUE) nodeInfo <- data.frame( name=c("Danielle","Josh","Mark","Emma","Sarah","Dave","Theresa","Carolyn","Gil"), age=c(44,44,40,32,33,36,38,42,30), sex=c("F","M","M","F","F","M","F","F","M"), handed=c("R","R","R","L","R","L","L","R","L"), lastDocVisit=c(2012,2008,2010,2012,2011,2007,2009,2009,2010), stringsAsFactors=FALSE ) } print(relations) # peek at matrix print(nodeInfo) # peek at attribute data # Since our relational data has no row/column names, let's set them now rownames(relations) <- nodeInfo$name colnames(relations) <- nodeInfo$name # create undirected network object from matrix nrelations<-network(relations,directed=FALSE) # it read in vertex names from matrix col names ... network.vertex.names(nrelations) # ATTACHING VERTEX ATTRIBUTES # ... but could also set vertex.names with nrelations\%v\%'vertex.names'<- nodeInfo$name # load in other attributes nrelations\%v\%"age" <- nodeInfo$age nrelations\%v\%"sex" <- nodeInfo$sex nrelations\%v\%"handed" <- nodeInfo$handed nrelations\%v\%"lastDocVisit" <- nodeInfo$lastDocVisit # Note: order of attributes in the data frame MUST match vertex ids # otherwise the attribute will get assigned to the wrong vertex # check that they got loaded list.vertex.attributes(nrelations) # what if we had an adjaceny matrix like: valuedMat<-matrix(c(1,2,3, 2,0,9.5,1,5,0),ncol=3,byrow=TRUE) valuedMat # make a network from it valuedNet<-network(valuedMat,loops=TRUE,directed=TRUE) # print it back out ... as.matrix(valuedNet) # wait, where did the values go!!? # LOADING A MATRIX WITH VALUES # to construct net from matrix with values: valuedNet<-network(valuedMat,loops=TRUE,directed=TRUE, ignore.eval=FALSE,names.eval='myEdgeWeight') # also have to specify the name of the attribute when converting to matrix as.matrix(valuedNet,attrname='myEdgeWeight') # ATTACHING EDGE ATTRIBUTES FROM A MATRIX # maybe we have edge attributes of a different sort in another matrix like: edgeAttrs<-matrix(c("B","Z","Q","W","A","E","L","P","A"),ncol=3,byrow=TRUE) edgeAttrs # we can still attach them valuedNet<-set.edge.value(valuedNet,'someLetters',edgeAttrs) # and extract them as.matrix(valuedNet,attrname='someLetters') valuedNet\%e\%'someLetters' # but notice that some of the values didn't get used # the ("A"s are missing) because there were no corresponding edges (loops) # for the attribute to be attached to # ATTACHING EDGE ATTRIBUTES FROM A LIST # it is also possible to attach edge attributes directly from a list edgeCols<-c("red","green","blue","orange","pink","brown","gray") valuedNet<-set.edge.attribute(valuedNet,"edgeColors",edgeCols) # but this can be risky, because we may not know the ordering of the edges, # (especially if some have been deleted). Does "green" go with the edge from # 1 to 2, or from 3 to 1? # Usually if the edge data is only availible in list form, it is safer to construct # the network from an edgelist in the first place # LOADING IN AN EDGELIST # pretend we just loaded in this data.frame from a file elData<-data.frame( from_id=c("1","2","3","1","3","1","2"), to_id=c("1", "1", "1", "2", "2", "3", "3"), myEdgeWeight=c(1, 2, 1, 2, 5, 3, 9.5), someLetters=c("B", "W", "L", "Z", "P", "Q", "E"), edgeCols=c("red","green","blue","orange","pink","brown","gray"), stringsAsFactors=FALSE ) # peek at data # each row corresponds to a relationship (edge) in the network elData # to make a network we just use the first two id columns valuedNet2<-network(elData[,1:2],loops=TRUE) # print it out as.matrix(valuedNet2) # has right edges, but no values # to include values (with names from the columns) valuedNet2<-network(elData,loops=TRUE) list.edge.attributes(valuedNet2) as.matrix(valuedNet2,attrname='someLetters') } \references{ Acton, R. M., Jasny, L (2012) \emph{An Introduction to Network Analysis with R and statnet} Sunbelt XXXII Workshop Series, March 13, 2012. Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{attribute.methods}}, \code{\link{as.network.matrix}}, \code{\link{as.sociomatrix}}, \code{\link{as.matrix.network}}, \code{\link{network.extraction}} } \keyword{classes} \keyword{graphs} network/man/network.edgelabel.Rd0000644000176200001440000000363013650471474016416 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.R \name{network.edgelabel} \alias{network.edgelabel} \title{Plots a label corresponding to an edge in a network plot.} \usage{ network.edgelabel( px0, py0, px1, py1, label, directed, loops = FALSE, cex, curve = 0, ... ) } \arguments{ \item{px0}{vector of x coordinates of tail vertex of the edge} \item{py0}{vector of y coordinates of tail vertex of the edge} \item{px1}{vector of x coordinates of head vertex of the edge} \item{py1}{vector of y coordinate of head vertex of the edge} \item{label}{vector strings giving labels to be drawn for edge edge} \item{directed}{logical: is the underlying network directed? If FALSE, labels will be drawn in the middle of the line segment, otherwise in the first 3rd so that the labels for edges pointing in the opposite direction will not overlap.} \item{loops}{logical: if true, assuming the labels to be drawn belong to loop-type edges and render appropriately} \item{cex}{numeric vector giving the text expansion factor for each label} \item{curve}{numeric vector controling the extent of edge curvature (0 = straight line edges)} \item{\dots}{additional arguments to be passed to \code{\link{text}}} } \value{ no value is returned but text will be rendered on the active plot } \description{ Draws a text labels on (or adjacent to) the line segments connecting vertices on a network plot. } \details{ Called internally by \code{\link{plot.network}} when \code{edge.label} parameter is used. For directed, non-curved edges, the labels are shifted towards the tail of the edge. Labels for curved edges are not shifted because opposite-direction edges curve the opposite way. Makes a crude attempt to shift labels to either side of line, and to draw the edge labels for self-loops near the vertex. No attempt is made to avoid overlap between vertex and edge labels. } \author{ skyebend } network/man/as.network.matrix.Rd0000644000176200001440000000712214057075374016421 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/coercion.R \name{as.network.matrix} \alias{as.network.matrix} \alias{as.network.default} \title{Coercion from Matrices to Network Objects} \usage{ \method{as.network}{default}(x, ...) \method{as.network}{matrix}( x, matrix.type = NULL, directed = TRUE, hyper = FALSE, loops = FALSE, multiple = FALSE, bipartite = FALSE, ignore.eval = TRUE, names.eval = NULL, na.rm = FALSE, edge.check = FALSE, ... ) } \arguments{ \item{x}{a matrix containing an adjacency structure} \item{...}{additional arguments} \item{matrix.type}{one of \code{"adjacency"}, \code{"edgelist"}, \code{"incidence"}, or \code{NULL}} \item{directed}{logical; should edges be interpreted as directed?} \item{hyper}{logical; are hyperedges allowed?} \item{loops}{logical; should loops be allowed?} \item{multiple}{logical; are multiplex edges allowed?} \item{bipartite}{count; should the network be interpreted as bipartite? If present (i.e., non-NULL) it is the count of the number of actors in the bipartite network. In this case, the number of nodes is equal to the number of actors plus the number of events (with all actors preceding all events). The edges are then interpreted as nondirected.} \item{ignore.eval}{logical; ignore edge values?} \item{names.eval}{optionally, the name of the attribute in which edge values should be stored} \item{na.rm}{logical; ignore missing entries when constructing the network?} \item{edge.check}{logical; perform consistency checks on new edges?} } \value{ An object of class \code{network} } \description{ \code{as.network.matrix} attempts to coerce its first argument to an object of class \code{network}. } \details{ Depending on \code{matrix.type}, one of three edgeset constructor methods will be employed to read the input matrix (see \code{\link{edgeset.constructors}}). If \code{matrix.type==NULL}, \code{\link{which.matrix.type}} will be used to guess the appropriate matrix type. The coercion methods will recognize and attempt to utilize the \code{sna} extended matrix attributes where feasible. These are as follows: \itemize{ \item\code{"n"}: taken to indicate number of vertices in the network. \item\code{"bipartite"}: taken to indicate the network's \code{bipartite} attribute, where present. \item\code{"vnames"}: taken to contain vertex names, where present. } These attributes are generally used with edgelists, and indeed data in \code{sna} edgelist format should be transparently converted in most cases. Where the extended matrix attributes are in conflict with the actual contents of \code{x}, results are no guaranteed (but the latter will usually override the former). For an edge list, the number of nodes in a network is determined by the number of unique nodes specified. If there are isolate nodes not in the edge list, the "n" attribute needs to be set. See example below. } \examples{ #Draw a random matrix m<-matrix(rbinom(25,1,0.5),5) diag(m)<-0 #Coerce to network form g<-as.network.matrix(m,matrix.type="adjacency") # edge list example. Only 4 nodes in the edge list. m = matrix(c(1,2, 2,3, 3,4), byrow = TRUE, nrow=3) attr(m, 'n') = 7 as.network(m, matrix.type='edgelist') } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{edgeset.constructors}}, \code{\link{network}}, \code{\link{which.matrix.type}} } \author{ Carter T. Butts \email{buttsc@uci.edu} and David Hunter \email{dhunter@stat.psu.edu} } \keyword{classes} \keyword{graphs} network/man/network.arrow.Rd0000644000176200001440000000543114057075374015646 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.R \name{network.arrow} \alias{network.arrow} \title{Add Arrows or Segments to a Plot} \usage{ network.arrow( x0, y0, x1, y1, length = 0.1, angle = 20, width = 0.01, col = 1, border = 1, lty = 1, offset.head = 0, offset.tail = 0, arrowhead = TRUE, curve = 0, edge.steps = 50, ... ) } \arguments{ \item{x0}{A vector of x coordinates for points of origin} \item{y0}{A vector of y coordinates for points of origin} \item{x1}{A vector of x coordinates for destination points} \item{y1}{A vector of y coordinates for destination points} \item{length}{Arrowhead length, in current plotting units} \item{angle}{Arrowhead angle (in degrees)} \item{width}{Width for arrow body, in current plotting units (can be a vector)} \item{col}{Arrow body color (can be a vector)} \item{border}{Arrow border color (can be a vector)} \item{lty}{Arrow border line type (can be a vector)} \item{offset.head}{Offset for destination point (can be a vector)} \item{offset.tail}{Offset for origin point (can be a vector)} \item{arrowhead}{Boolean; should arrowheads be used? (Can be a vector))} \item{curve}{Degree of edge curvature (if any), in current plotting units (can be a vector)} \item{edge.steps}{For curved edges, the number of steps to use in approximating the curve (can be a vector)} \item{\dots}{Additional arguments to \code{\link{polygon}}} } \value{ None. } \description{ \code{network.arrow} draws a segment or arrow between two pairs of points; unlike \code{\link{arrows}} or \code{\link{segments}}, the new plot element is drawn as a polygon. } \details{ \code{network.arrow} provides a useful extension of \code{\link{segments}} and \code{\link{arrows}} when fine control is needed over the resulting display. (The results also look better.) Note that edge curvature is quadratic, with \code{curve} providing the maximum horizontal deviation of the edge (left-handed). Head/tail offsets are used to adjust the end/start points of an edge, relative to the baseline coordinates; these are useful for functions like \code{\link{plot.network}}, which need to draw edges incident to vertices of varying radii. } \note{ \code{network.arrow} is a direct adaptation of \code{\link[sna]{gplot.arrow}} from the \code{sna} package. } \examples{ #Plot two points plot(1:2,1:2) #Add an edge network.arrow(1,1,2,2,width=0.01,col="red",border="black") } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{plot.network}}, \code{\link{network.loop}}, \code{\link{polygon}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{aplot} \keyword{graphs} network/man/get.inducedSubgraph.Rd0000644000176200001440000000673413566403644016717 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R, R/operators.R \name{get.inducedSubgraph} \alias{get.inducedSubgraph} \alias{\%s\%} \title{Retrieve Induced Subgraphs and Cuts} \usage{ get.inducedSubgraph(x, v, alters = NULL, eid = NULL) x \%s\% v } \arguments{ \item{x}{an object of class \code{network}.} \item{v}{a vector of vertex IDs, or, for \code{\%s\%}, optionally a list containing two disjoint vectors of vertex IDs (see below).} \item{alters}{optionally, a second vector of vertex IDs. Must be disjoint with \code{v}.} \item{eid}{optionally, a numeric vector of valid edge ids in \code{x} that should be retained (cannot be used with \code{v} or \code{alter})} } \value{ A \code{\link{network}} object containing the induced subgraph. } \description{ Given a set of vertex IDs, \code{get.inducedSubgraph} returns the subgraph induced by the specified vertices (i.e., the vertices and all associated edges). Optionally, passing a second set of alters returns the cut from the first to the second set (i.e., all edges passing between the sets), along with the associated endpoints. Alternatively, passing in a vector of edge ids will induce a subgraph containing the specified edges and their incident vertices. In all cases, the result is returned as a network object, with all attributes of the selected edges and/or vertices (and any network attributes) preserved. } \details{ For \code{get.inducedSubgraph}, \code{v} can be a vector of vertex IDs. If \code{alter=NULL}, the subgraph induced by these vertices is returned. Calling \code{\%s\%} with a single vector of vertices has an identical effect. Where \code{alters} is specified, it must be a vector of IDs disjoint with \code{v}. Where both are given, the edges spanning \code{v} and \code{alters} are returned, along with the vertices in question. (Technically, only the edges really constitute the \dQuote{cut,} but the vertices are included as well.) The same result can be obtained with the \code{\%s\%} operator by passing a two-element list on the right hand side; the first element is then interpreted as \code{v}, and the second as \code{alters}. When \code{eid} is specified, the \code{v} and \code{alters} argument will be ignored and the subgraph induced by the specified edges and their incident vertices will be returned. Any network, vertex, or edge attributes for the selected network elements are retained (although features such as vertex IDs and the network size will typically change). These are copies of the elements in the original network, which is not altered by this function. } \examples{ #Load the Drabek et al. EMON data data(emon) #For the Mt. St. Helens, EMON, several types of organizations are present: type<-emon$MtStHelens \%v\% "Sponsorship" #Plot interactions among the state organizations plot(emon$MtStHelens \%s\% which(type=="State"), displaylabels=TRUE) #Plot state/federal interactions plot(emon$MtStHelens \%s\% list(which(type=="State"), which(type=="Federal")), displaylabels=TRUE) #Plot state interactions with everyone else plot(emon$MtStHelens \%s\% list(which(type=="State"), which(type!="State")), displaylabels=TRUE) # plot only interactions with frequency of 2 subG2<-get.inducedSubgraph(emon$MtStHelens, eid=which(emon$MtStHelens\%e\%'Frequency'==2)) plot(subG2,edge.label='Frequency') } \seealso{ \code{\link{network}}, \code{\link{network.extraction}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{graphs} \keyword{manip} network/man/network-operators.Rd0000644000176200001440000001251014057075374016525 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{network.operators} \alias{network.operators} \alias{+.network} \alias{\%c\%} \alias{-.network} \alias{*.network} \alias{!.network} \alias{|.network} \alias{&.network} \alias{\%c\%.network} \title{Network Operators} \usage{ \method{+}{network}(e1, e2) \method{-}{network}(e1, e2) \method{*}{network}(e1, e2) \method{!}{network}(e1) \method{|}{network}(e1, e2) \method{&}{network}(e1, e2) \method{\%c\%}{network}(e1, e2) } \arguments{ \item{e1}{an object of class \code{network}.} \item{e2}{another \code{network}.} } \value{ The resulting network. } \description{ These operators allow for algebraic manipulation of relational structures. } \details{ In general, the binary network operators function by producing a new network object whose edge structure is based on that of the input networks. The properties of the new structure depend upon the inputs as follows: \itemize{ \item The size of the new network is equal to the size of the input networks (for all operators save \code{\%c\%}), which must themselves be of equal size. Likewise, the \code{bipartite} attributes of the inputs must match, and this is preserved in the output. \item If either input network allows loops, multiplex edges, or hyperedges, the output acquires this property. (If both input networks do not allow these features, then the features are disallowed in the output network.) \item If either input network is directed, the output is directed; if exactly one input network is directed, the undirected input is treated as if it were a directed network in which all edges are reciprocated. \item Supplemental attributes (including vertex names, but not edgwise missingness) are not transferred to the output. } The unary operator acts per the above, but with a single input. Thus, the output network has the same properties as the input, with the exception of supplemental attributes. The behavior of the composition operator, \code{\%c\%}, is somewhat more complex than the others. In particular, it will return a bipartite network whenever either input network is bipartite \emph{or} the vertex names of the two input networks do not match (or are missing). If both inputs are non-bipartite and have identical vertex names, the return value will have the same structure (but with loops). This behavior corresponds to the interpretation of the composition operator as counting walks on labeled sets of vertices. Hypergraphs are not yet supported by these routines, but ultimately will be (as suggested by the above). The specific operations carried out by these operators are generally self-explanatory in the non-multiplex case, but semantics in the latter circumstance bear elaboration. The following summarizes the behavior of each operator: \describe{ \item{\code{+}}{An \eqn{(i,j)} edge is created in the return graph for every \eqn{(i,j)} edge in each of the input graphs.} \item{\code{-}}{An \eqn{(i,j)} edge is created in the return graph for every \eqn{(i,j)} edge in the first input that is not matched by an \eqn{(i,j)} edge in the second input; if the second input has more \eqn{(i,j)} edges than the first, no \eqn{(i,j)} edges are created in the return graph.} \item{\code{*}}{An \eqn{(i,j)} edge is created for every pairing of \eqn{(i,j)} edges in the respective input graphs.} \item{\code{\%c\%}}{An \eqn{(i,j)} edge is created in the return graph for every edge pair \eqn{(i,k),(k,j)} with the first edge in the first input and the second edge in the second input.} \item{\code{!}}{An \eqn{(i,j)} edge is created in the return graph for every \eqn{(i,j)} in the input not having an edge.} \item{\code{|}}{An \eqn{(i,j)} edge is created in the return graph if either input contains an \eqn{(i,j)} edge.} \item{\code{&}}{An \eqn{(i,j)} edge is created in the return graph if both inputs contain an \eqn{(i,j)} edge.} } Semantics for missing-edge cases follow from the above, under the interpretation that edges with \code{na==TRUE} are viewed as having an unknown state. Thus, for instance, \code{x*y} with \code{x} having 2 \eqn{(i,j)} non-missing and 1 missing edge and \code{y} having 3 respective non-missing and 2 missing edges will yield an output network with 6 non-missing and 9 missing \eqn{(i,j)} edges. } \note{ Currently, there is a naming conflict between the composition operator and the \code{\%c\%} operator in the \code{\link[sna]{sna}} package. This will be resolved in future releases; for the time being, one can determine which version of \code{\%c\%} is in use by varying which package is loaded first. } \examples{ #Create an in-star m<-matrix(0,6,6) m[2:6,1]<-1 g<-network(m) plot(g) #Compose g with its transpose gcgt<-g \%c\% (network(t(m))) plot(gcgt) gcgt #Show the complement of g !g #Perform various arithmatic and logical operations (g+gcgt)[,] == (g|gcgt)[,] #All TRUE (g-gcgt)[,] == (g&(!(gcgt)))[,] (g*gcgt)[,] == (g&gcgt)[,] } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} Wasserman, S. and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: University of Cambridge Press. } \seealso{ \code{\link{network.extraction}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{graphs} \keyword{math} network/man/sum.network.Rd0000644000176200001440000000440314057075374015316 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{sum.network} \alias{sum.network} \title{Combine Networks by Edge Value Addition} \usage{ \method{sum}{network}(..., attrname = NULL, na.rm = FALSE) } \arguments{ \item{\dots}{one or more \code{network} objects.} \item{attrname}{the name of an edge attribute to use when assessing edge values, if desired.} \item{na.rm}{logical; should edges with missing data be ignored?} } \value{ A \code{\link{network}} object. } \description{ Given a series of networks, \code{sum.network} attempts to form a new network by accumulation of edges. If a non-null \code{attrname} is given, the corresponding edge attribute is used to determine and store edge values. } \details{ The network summation method attempts to combine its arguments by addition of their respective adjacency matrices; thus, this method is only applicable for networks whose adjacency coercion is well-behaved. Addition is effectively boolean unless \code{attrname} is specified, in which case this is used to assess edge values -- net values of 0 will result in removal of the underlying edge. Other network attributes in the return value are carried over from the first element in the list, so some persistence is possible (unlike the addition operator). Note that it is sometimes possible to \dQuote{add} networks and raw adjacency matrices using this routine (if all dimensions are correct), but more exotic combinations may result in regrettably exciting behavior. } \examples{ #Create some networks g<-network.initialize(5) h<-network.initialize(5) i<-network.initialize(5) g[1,,names.eval="marsupial",add.edges=TRUE]<-1 h[1:2,,names.eval="marsupial",add.edges=TRUE]<-2 i[1:3,,names.eval="marsupial",add.edges=TRUE]<-3 #Combine by addition pouch<-sum(g,h,i,attrname="marsupial") pouch[,] #Edge values in the pouch? as.sociomatrix(pouch,attrname="marsupial") #Recover the marsupial } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{network.operators}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{arith} \keyword{graphs} network/man/get.edges.Rd0000644000176200001440000000571414057075374014675 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{get.edges} \alias{get.edges} \alias{get.edgeIDs} \alias{get.dyads.eids} \title{Retrieve Edges or Edge IDs Associated with a Given Vertex} \usage{ get.edgeIDs( x, v, alter = NULL, neighborhood = c("out", "in", "combined"), na.omit = TRUE ) get.edges( x, v, alter = NULL, neighborhood = c("out", "in", "combined"), na.omit = TRUE ) get.dyads.eids(x, tails, heads, neighborhood = c("out", "in", "combined")) } \arguments{ \item{x}{an object of class \code{network}} \item{v}{a vertex ID} \item{alter}{optionally, the ID of another vertex} \item{neighborhood}{an indicator for whether we are interested in in-edges, out-edges, or both (relative to \code{v}). defaults to \code{'combined'} for undirected networks} \item{na.omit}{logical; should we omit missing edges?} \item{tails}{a vector of vertex ID for the 'tails' (v) side of the dyad} \item{heads}{a vector of vertex ID for the 'heads' (alter) side of the dyad} } \value{ For \code{get.edges}, a list of edges. For \code{get.edgeIDs}, a vector of edge ID numbers. For \code{get.dyads.eids}, a list of edge IDs corresponding to the dyads defined by the vertex ids in \code{tails} and \code{heads} } \description{ \code{get.edges} retrieves a list of edges incident on a given vertex; \code{get.edgeIDs} returns the internal identifiers for those edges, instead. Both allow edges to be selected based on vertex neighborhood and (optionally) an additional endpoint. } \details{ By default, \code{get.edges} returns all out-, in-, or out- and in-edges containing \code{v}. \code{get.edgeIDs} is identical, save in its return value, as it returns only the ids of the edges. Specifying a vertex in \code{alter} causes these edges to be further selected such that alter must also belong to the edge -- this can be used to extract edges between two particular vertices. Omission of missing edges is accomplished via \code{na.omit}. Note that for multiplex networks, multiple edges or edge ids can be returned. The function \code{get.dyads.eids} simplifies the process of looking up the edge ids associated with a set of 'dyads' (tail and head vertex ids) for edges. It only is intended for working with non-multiplex networks and will return a warning and \code{NA} value for any dyads that correspond to multiple edges. The value \code{numeric(0)} will be returned for any dyads that do not have a corresponding edge. } \examples{ #Create a network with three edges m<-matrix(0,3,3) m[1,2]<-1; m[2,3]<-1; m[3,1]<-1 g<-network(m) get.edges(g,1,neighborhood="out") get.edgeIDs(g,1,neighborhood="in") } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{get.neighborhood}}, \code{\link{valid.eids}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{classes} \keyword{graphs} network/man/network-package.Rd0000644000176200001440000001252314057014734016077 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/network-package.R \docType{package} \name{network-package} \alias{network-package} \title{Classes for Relational Data} \description{ Tools to create and modify network objects. The network class can represent a range of relational data types, and supports arbitrary vertex/edge/graph attributes. } \details{ The \code{network} package provides tools for creation, access, and modification of \code{network} class objects. These objects allow for the representation of more complex structures than can be readily handled by other means (e.g., adjacency matrices), and are substantially more efficient in handling large, sparse networks. While the full capabilities of the \code{network} class can only be exploited by means of the various custom interface methods (see below), many simple tasks are streamlined through the use of operator overloading; in particular, network objects can often be treated as if they were adjacency matrices (a representation which will be familiar to users of the \code{sna} package). \code{network} objects are compatible with the \code{sna} package, and are required for many packages in the \code{statnet} bundle. Basic information on the creation of \code{network} objects can be found by typing \code{help(network)}. To learn about setting, modifying, or deleting network, vertex, or edge attributes, see \code{help(attribute.methods)}. For information on custom network operators, type \code{help(network.operators)}; information on overloaded operators can be found via \code{help(network.extraction)}. Additional help topics are listed below. \tabular{ll}{ Package: \tab network\cr Version: \tab 1.14\cr Date: \tab May 7, 2016\cr Depends: \tab R (>= 2.10), utils\cr Suggests: \tab sna, statnet.common (>= 3.1-0)\cr License: \tab GPL (>=2)\cr } Index of documentation pages: \preformatted{ add.edges Add Edges to a Network Object add.vertices Add Vertices to an Existing Network as.matrix.network Coerce a Network Object to Matrix Form as.network.matrix Coercion from Matrices to Network Objects as.sociomatrix Coerce One or More Networks to Sociomatrix Form attribute.methods Attribute Interface Methods for the Network Class deletion.methods Remove Elements from a Network Object edgeset.constructors Edgeset Constructors for Network Objects emon Interorganizational Search and Rescue Networks (Drabek et al.) flo Florentine Wedding Data (Padgett) get.edges Retrieve Edges or Edge IDs Associated with a Given Vertex get.inducedSubgraph Retrieve Induced Subgraphs and Cuts get.neighborhood Obtain the Neighborhood of a Given Vertex is.adjacent Determine Whether Two Vertices Are Adjacent loading.attributes Examples of how to load vertex and edge attributes into networks missing.edges Identifying and Counting Missing Edges in a Network Object network Network Objects network.arrow Add Arrows or Segments to a Plot network.density Compute the Density of a Network network.dyadcount Return the Number of (Possibly Directed) Dyads in a Network Object network.edgecount Return the Number of Edges in a Network Object network.edgelabel Plots a label corresponding to an edge in a network plot. network.extraction Extraction and Replacement Operators for Network Objects network.indicators Indicator Functions for Network Properties network.initialize Initialize a Network Class Object network.layout Vertex Layout Functions for plot.network network.loop Add Loops to a Plot network.operators Network Operators network-package Classes for Relational Data network.size Return the Size of a Network network.vertex Add Vertices to a Plot permute.vertexIDs Permute (Relabel) the Vertices Within a Network plotArgs.network Expand and transform attributes of networks to values appropriate for aguments to plot.network plot.network.default Two-Dimensional Visualization for Network Objects prod.network Combine Networks by Edge Value Multiplication read.paj Read a Pajek Project or Network File and Convert to an R 'Network' Object sum.network Combine Networks by Edge Value Addition valid.eids Get the valid edge which are valid in a network which.matrix.type Heuristic Determination of Matrix Types for Network Storage } } \author{ Carter T. Butts \href{mailto:buttsc@uci.edu}{buttsc@uci.edu}, with help from Mark S. Handcock \href{mailto:handcock@stat.ucla.edu}{handcock@stat.ucla.edu}, David Hunter \href{mailto:dhunter@stat.psu.edu}{dhunter@stat.psu.edu}, Martina Morris \href{mailto:morrism@u.washington.edu}{morrism@u.washington.edu}, Skye Bender-deMoll \href{mailto:skyebend@u.washington.edu}{skyebend@u.washington.edu}, and Jeffrey Horner \href{mailto:jeffrey.horner@gmail.com}{jeffrey.horner@gmail.com}. Maintainer: Carter T. Butts \href{mailto:buttsc@uci.edu}{buttsc@uci.edu} } \keyword{package} network/man/read.paj.Rd0000644000176200001440000001410514057014734014477 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fileio.R \name{read.paj} \alias{read.paj} \alias{read.paj.simplify} \alias{switchArcDirection} \alias{readAndVectorizeLine} \title{Read a Pajek Project or Network File and Convert to an R 'Network' Object} \usage{ read.paj( file, verbose = FALSE, debug = FALSE, edge.name = NULL, simplify = FALSE, time.format = c("pajekTiming", "networkDynamic") ) } \arguments{ \item{file}{the name of the file whence the data are to be read. If it does not contain an absolute path, the file name is relative to the current working directory (as returned by \code{\link{getwd}}). \code{file} can also be a complete URL.} \item{verbose}{logical: Should longer descriptions of the reading and coercion process be printed out?} \item{debug}{logical: Should very detailed descriptions of the reading and coercion process be printed out? This is typically used to debug the reading of files that are corrupted on coercion.} \item{edge.name}{optional name for the edge variable read from the file. The default is to use the value in the project file if found.} \item{simplify}{Should the returned network be simplified as much as possible and saved? The values specifies the name of the file which the data are to be stored. If it does not contain an absolute path, the file name is relative to the current working directory (see \code{\link{getwd}}). If \code{specify} is TRUE the file name is the name \code{file}.} \item{time.format}{if the network has timing information attached to edges/vertices, how should it be processed? \code{'pajekTiming'} will attach the timing information unchanged in an attribute named \code{pajek.timing}. \code{'networkDynamic'} will translate it to a spell matrix format, attach it as an \code{'activity'} attribute and add the class \code{'networkDynamic'} -- formating it for use by the \code{networkDynamic} package.} } \value{ The structure of the object returned by \code{read.paj} depends on the contents of the file it parses. \itemize{ \item if input file contains information about a single 'network' object (i.e .net input file) a single network object is returned with attribute data set appropriately if possible. or a list of networks (for .paj input). \item if input file contains multiple sets of relations for a single network, a list of network objects ('network.series') is returned, along with a formula object?. \item if input .paj file contains additional information (like partition information), or multiple \code{*Network} definitions a two element list is returned. The first element is a list of all the network objects created, and the second is a list of partitions, etc. (how are these matched up) } } \description{ Return a (list of) \code{\link{network}} object(s) after reading a corresponding .net or .paj file. The code accepts ragged array edgelists, but cannot currently handle 2-mode, multirelational (e.g. KEDS), or networks with entries for both edges and arcs (e.g. GD-a99m). See \code{network}, \code{statnet}, or \code{sna} for more information. } \details{ If the \code{*Vertices} block includes the optional graphic attributes (coordinates, shape, size, etc.) they will be read attached to the network as vertex attributes but values will not be interperted (i.e. Pajek's color names will not be translated to R color names). Vertex attributes included in a \code{*Vector} block will be attached as vertex attributes. Edges or Arc weights in the \code{*Arcs} or \code{*Edges} block are include in the network as an attribute with the same name as the network. If no weight is included, a default weight of 1 is used. Optional graphic attributes or labels will be attached as edge attributes. If the file contains an empty \code{Arcs} block, an undirected network will be returned. Otherwise the network will be directed, with two edges (one in each direction) added for every row in the \code{*Edges} block. If the \code{*Vertices}, \code{*Arcs} or \code{*Edges} blocks having timing information included in the rows (indicated by \code{...} tokens), it will be attached to the vertices with behavior determined by the \code{time.format} option. If the \code{'networkDynamic'} format is used, times will be translated to \code{networkDynamic}'s spell model with the assumtion that the original Pajek representation was indicating discrete time chunks. For example \code{"[5-10]"} will become the spell \code{[5,11]}, \code{"[2-*]"} will become \code{[2,Inf]} and \code{"[7]"} will become \code{[7,8]}. See documentation for \code{networkDynamic}'s \code{?activity.attribute} for details. The \code{*Arcslist}, \code{*Edgelist} and \code{*Events} blocks are not yet supported. As there is no known single complete specification for the file format, parsing behavior has been infered from references and examples below. } \examples{ \dontrun{ require(network) par(mfrow=c(2,2)) test.net.1 <- read.paj("http://vlado.fmf.uni-lj.si/pub/networks/data/GD/gd98/A98.net") plot(test.net.1,main=test.net.1\%n\%'title') test.net.2 <- read.paj("http://vlado.fmf.uni-lj.si/pub/networks/data/mix/USAir97.net") # plot using coordinates from the file in the file plot(test.net.2,main=test.net.2\%n\%'title', coord=cbind(test.net.2\%v\%'x', test.net.2\%v\%'y'), jitter=FALSE) # read .paj project file # notice output has $networks and $partitions read.paj('http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/Tina.paj') } } \references{ Batagelj, Vladimir and Mrvar, Andrej (2011) Pajek Reference Manual version 2.05 \url{http://vlado.fmf.uni-lj.si/pub/networks/pajek/doc/pajekman.pdf} Section 5.3 pp 73-79 Batageli, Vladimir (2008) "Network Analysis Description of Networks" \url{http://vlado.fmf.uni-lj.si/pub/networks/doc/ECPR/08/ECPR01.pdf} Pajek Datasets \url{http://vlado.fmf.uni-lj.si/pub/networks/data/esna/} } \seealso{ \code{\link{network}} } \author{ Dave Schruth \email{dschruth@u.washington.edu}, Mark S. Handcock \email{handcock@stat.washington.edu} (with additional input from Alex Montgomery \email{ahm@reed.edu}), Skye Bender-deMoll \email{skyebend@uw.edu} } \keyword{datasets} network/man/prod.network.Rd0000644000176200001440000000450714057075374015463 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{prod.network} \alias{prod.network} \title{Combine Networks by Edge Value Multiplication} \usage{ \method{prod}{network}(..., attrname = NULL, na.rm = FALSE) } \arguments{ \item{\dots}{one or more \code{network} objects.} \item{attrname}{the name of an edge attribute to use when assessing edge values, if desired.} \item{na.rm}{logical; should edges with missing data be ignored?} } \value{ A \code{\link{network}} object. } \description{ Given a series of networks, \code{prod.network} attempts to form a new network by multiplication of edges. If a non-null \code{attrname} is given, the corresponding edge attribute is used to determine and store edge values. } \details{ The network product method attempts to combine its arguments by edgewise multiplication (\emph{not} composition) of their respective adjacency matrices; thus, this method is only applicable for networks whose adjacency coercion is well-behaved. Multiplication is effectively boolean unless \code{attrname} is specified, in which case this is used to assess edge values -- net values of 0 will result in removal of the underlying edge. Other network attributes in the return value are carried over from the first element in the list, so some persistence is possible (unlike the multiplication operator). Note that it is sometimes possible to \dQuote{multiply} networks and raw adjacency matrices using this routine (if all dimensions are correct), but more exotic combinations may result in regrettably exciting behavior. } \examples{ #Create some networks g<-network.initialize(5) h<-network.initialize(5) i<-network.initialize(5) g[1:3,,names.eval="marsupial",add.edges=TRUE]<-1 h[1:2,,names.eval="marsupial",add.edges=TRUE]<-2 i[1,,names.eval="marsupial",add.edges=TRUE]<-3 #Combine by addition pouch<-prod(g,h,i,attrname="marsupial") pouch[,] #Edge values in the pouch? as.sociomatrix(pouch,attrname="marsupial") #Recover the marsupial } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{network.operators}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{arith} \keyword{graphs} network/man/plot.network.Rd0000644000176200001440000002376414057075374015503 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.R \name{plot.network.default} \alias{plot.network.default} \alias{plot.network} \title{Two-Dimensional Visualization for Network Objects} \usage{ \method{plot}{network}(x, ...) \method{plot.network}{default}(x, attrname = NULL, label = network.vertex.names(x), coord = NULL, jitter = TRUE, thresh = 0, usearrows = TRUE, mode = "fruchtermanreingold", displayisolates = TRUE, interactive = FALSE, xlab = NULL, ylab = NULL, xlim = NULL, ylim = NULL, pad = 0.2, label.pad = 0.5, displaylabels = !missing(label), boxed.labels = FALSE, label.pos = 0, label.bg = "white", vertex.sides = 50, vertex.rot = 0, vertex.lwd=1, arrowhead.cex = 1, label.cex = 1, loop.cex = 1, vertex.cex = 1, edge.col = 1, label.col = 1, vertex.col = 2, label.border = 1, vertex.border = 1, edge.lty = 1, label.lty = NULL, vertex.lty = 1, edge.lwd = 0, edge.label = NULL, edge.label.cex = 1, edge.label.col = 1, label.lwd = par("lwd"), edge.len = 0.5, edge.curve = 0.1, edge.steps = 50, loop.steps = 20, object.scale = 0.01, uselen = FALSE, usecurve = FALSE, suppress.axes = TRUE, vertices.last = TRUE, new = TRUE, layout.par = NULL, \dots) } \arguments{ \item{x}{an object of class \code{network}.} \item{\dots}{additional arguments to \code{\link{plot}}.} \item{attrname}{an optional edge attribute, to be used to set edge values.} \item{label}{a vector of vertex labels, if desired; defaults to the vertex labels returned by \code{\link{network.vertex.names}}. If \code{label} has one element and it matches with a vertex attribute name, the value of the attribute will be used. Note that labels may be set but hidden by the \code{displaylabels} argument.} \item{coord}{user-specified vertex coordinates, in an network.size(x)x2 matrix. Where this is specified, it will override the \code{mode} setting.} \item{jitter}{boolean; should the output be jittered?} \item{thresh}{real number indicating the lower threshold for tie values. Only ties of value >\code{thresh} are displayed. By default, \code{thresh}=0.} \item{usearrows}{boolean; should arrows (rather than line segments) be used to indicate edges?} \item{mode}{the vertex placement algorithm; this must correspond to a \code{\link{network.layout}} function.} \item{displayisolates}{boolean; should isolates be displayed?} \item{interactive}{boolean; should interactive adjustment of vertex placement be attempted?} \item{xlab}{x axis label.} \item{ylab}{y axis label.} \item{xlim}{the x limits (min, max) of the plot.} \item{ylim}{the y limits of the plot.} \item{pad}{amount to pad the plotting range; useful if labels are being clipped.} \item{label.pad}{amount to pad label boxes (if \code{boxed.labels==TRUE}), in character size units.} \item{displaylabels}{boolean; should vertex labels be displayed?} \item{boxed.labels}{boolean; place vertex labels within boxes?} \item{label.pos}{position at which labels should be placed, relative to vertices. \code{0} results in labels which are placed away from the center of the plotting region; \code{1}, \code{2}, \code{3}, and \code{4} result in labels being placed below, to the left of, above, and to the right of vertices (respectively); and \code{label.pos>=5} results in labels which are plotted with no offset (i.e., at the vertex positions).} \item{label.bg}{background color for label boxes (if \code{boxed.labels==TRUE}); may be a vector, if boxes are to be of different colors.} \item{vertex.sides}{number of polygon sides for vertices; may be given as a vector or a vertex attribute name, if vertices are to be of different types. As of v1.12, radius of polygons are scaled so that all shapes have equal area} \item{vertex.rot}{angle of rotation for vertices (in degrees); may be given as a vector or a vertex attribute name, if vertices are to be rotated differently.} \item{vertex.lwd}{line width of vertex borders; may be given as a vector or a vertex attribute name, if vertex borders are to have different line widths.} \item{arrowhead.cex}{expansion factor for edge arrowheads.} \item{label.cex}{character expansion factor for label text.} \item{loop.cex}{expansion factor for loops; may be given as a vector or a vertex attribute name, if loops are to be of different sizes.} \item{vertex.cex}{expansion factor for vertices; may be given as a vector or a vertex attribute name, if vertices are to be of different sizes.} \item{edge.col}{color for edges; may be given as a vector, adjacency matrix, or edge attribute name, if edges are to be of different colors.} \item{label.col}{color for vertex labels; may be given as a vector or a vertex attribute name, if labels are to be of different colors.} \item{vertex.col}{color for vertices; may be given as a vector or a vertex attribute name, if vertices are to be of different colors.} \item{label.border}{label border colors (if \code{boxed.labels==TRUE}); may be given as a vector, if label boxes are to have different colors.} \item{vertex.border}{border color for vertices; may be given as a vector or a vertex attribute name, if vertex borders are to be of different colors.} \item{edge.lty}{line type for edge borders; may be given as a vector, adjacency matrix, or edge attribute name, if edge borders are to have different line types.} \item{label.lty}{line type for label boxes (if \code{boxed.labels==TRUE}); may be given as a vector, if label boxes are to have different line types.} \item{vertex.lty}{line type for vertex borders; may be given as a vector or a vertex attribute name, if vertex borders are to have different line types.} \item{edge.lwd}{line width scale for edges; if set greater than 0, edge widths are scaled by \code{edge.lwd*dat}. May be given as a vector, adjacency matrix, or edge attribute name, if edges are to have different line widths.} \item{edge.label}{if non-\code{NULL}, labels for edges will be drawn. May be given as a vector, adjacency matrix, or edge attribute name, if edges are to have different labels. A single value of \code{TRUE} will use edge ids as labels. NOTE: currently doesn't work for curved edges.} \item{edge.label.cex}{character expansion factor for edge label text; may be given as a vector or a edge attribute name, if edge labels are to have different sizes.} \item{edge.label.col}{color for edge labels; may be given as a vector or a edge attribute name, if labels are to be of different colors.} \item{label.lwd}{line width for label boxes (if \code{boxed.labels==TRUE}); may be given as a vector, if label boxes are to have different line widths.} \item{edge.len}{if \code{uselen==TRUE}, curved edge lengths are scaled by \code{edge.len}.} \item{edge.curve}{if \code{usecurve==TRUE}, the extent of edge curvature is controlled by \code{edge.curv}. May be given as a fixed value, vector, adjacency matrix, or edge attribute name, if edges are to have different levels of curvature.} \item{edge.steps}{for curved edges (excluding loops), the number of line segments to use for the curve approximation.} \item{loop.steps}{for loops, the number of line segments to use for the curve approximation.} \item{object.scale}{base length for plotting objects, as a fraction of the linear scale of the plotting region. Defaults to 0.01.} \item{uselen}{boolean; should we use \code{edge.len} to rescale edge lengths?} \item{usecurve}{boolean; should we use \code{edge.curve}?} \item{suppress.axes}{boolean; suppress plotting of axes?} \item{vertices.last}{boolean; plot vertices after plotting edges?} \item{new}{boolean; create a new plot? If \code{new==FALSE}, vertices and edges will be added to the existing plot.} \item{layout.par}{parameters to the \code{\link{network.layout}} function specified in \code{mode}.} } \value{ A two-column matrix containing the vertex positions as x,y coordinates } \description{ \code{plot.network} produces a simple two-dimensional plot of network \code{x}, using optional attribute \code{attrname} to set edge values. A variety of options are available to control vertex placement, display details, color, etc. } \details{ \code{plot.network} is the standard visualization tool for the \code{network} class. By means of clever selection of display parameters, a fair amount of display flexibility can be obtained. Vertex layout -- if not specified directly using \code{coord} -- is determined via one of the various available algorithms. These should be specified via the \code{mode} argument; see \code{\link{network.layout}} for a full list. User-supplied layout functions are also possible -- see the aforementioned man page for details. Note that where \code{is.hyper(x)==TRUE}, the network is converted to bipartite adjacency form prior to computing coordinates. If \code{interactive==TRUE}, then the user may modify the initial network layout by selecting an individual vertex and then clicking on the location to which this vertex is to be moved; this process may be repeated until the layout is satisfactory. } \note{ \code{plot.network} is adapted (with minor modifications) from the \code{\link[sna]{gplot}} function of the \code{sna} library (authors: Carter T. Butts and Alex Montgomery); eventually, these two packages will be integrated. } \examples{ #Construct a sparse graph m<-matrix(rbinom(100,1,1.5/9),10) diag(m)<-0 g<-network(m) #Plot the graph plot(g) #Load Padgett's marriage data data(flo) nflo<-network(flo) #Display the network, indicating degree and flagging the Medicis plot(nflo, vertex.cex=apply(flo,2,sum)+1, usearrows=FALSE, vertex.sides=3+apply(flo,2,sum), vertex.col=2+(network.vertex.names(nflo)=="Medici")) } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} Wasserman, S., and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. } \seealso{ \code{\link{network}}, \code{\link{network.arrow}}, \code{\link{network.loop}}, \code{\link{network.vertex}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{graphs} \keyword{hplot} network/man/which.matrix.type.Rd0000644000176200001440000000304714057075374016412 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.R \name{which.matrix.type} \alias{which.matrix.type} \title{Heuristic Determination of Matrix Types for Network Storage} \usage{ which.matrix.type(x) } \arguments{ \item{x}{a matrix, or an object of class \code{network}} } \value{ One of \code{"adjacency"}, \code{"incidence"}, or \code{"edgelist"} } \description{ \code{which.matrix.type} attempts to choose an appropriate matrix expression for a \code{network} object, or (if its argument is a matrix) attempts to determine whether the matrix is of type adjacency, incidence, or edgelist. } \details{ The heuristics used to determine matrix types are fairly arbitrary, and should be avoided where possible. This function is intended to provide a modestly intelligent fallback option when explicit identification by the user is not possible. } \examples{ #Create an arbitrary adjacency matrix m<-matrix(rbinom(25,1,0.5),5,5) diag(m)<-0 #Can we guess the type? which.matrix.type(m) #Try the same thing with a network g<-network(m) which.matrix.type(g) which.matrix.type(as.matrix.network(g,matrix.type="incidence")) which.matrix.type(as.matrix.network(g,matrix.type="edgelist")) } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{as.matrix.network}}, \code{\link{as.network.matrix}} } \author{ David Hunter \email{dhunter@stat.psu.edu} } \keyword{graphs} network/man/network.vertex.Rd0000644000176200001440000000347314057075374016035 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.R \name{network.vertex} \alias{network.vertex} \title{Add Vertices to a Plot} \usage{ network.vertex( x, y, radius = 1, sides = 4, border = 1, col = 2, lty = NULL, rot = 0, lwd = 1, ... ) } \arguments{ \item{x}{a vector of x coordinates.} \item{y}{a vector of y coordinates.} \item{radius}{a vector of vertex radii.} \item{sides}{a vector containing the number of sides to draw for each vertex.} \item{border}{a vector of vertex border colors.} \item{col}{a vector of vertex interior colors.} \item{lty}{a vector of vertex border line types.} \item{rot}{a vector of vertex rotation angles (in degrees).} \item{lwd}{a vector of vertex border line widths.} \item{\dots}{Additional arguments to \code{\link{polygon}}} } \value{ None } \description{ \code{network.vertex} adds one or more vertices (drawn using \code{\link{polygon}}) to a plot. } \details{ \code{network.vertex} draws regular polygons of specified radius and number of sides, at the given coordinates. This is useful for routines such as \code{\link{plot.network}}, which use such shapes to depict vertices. } \note{ \code{network.vertex} is a direct adaptation of \code{\link[sna]{gplot.vertex}} from the \code{sna} package. } \examples{ #Open a plot window, and place some vertices plot(0,0,type="n",xlim=c(-1.5,1.5),ylim=c(-1.5,1.5),asp=1) network.vertex(cos((1:10)/10*2*pi),sin((1:10)/10*2*pi),col=1:10, sides=3:12,radius=0.1) } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{plot.network}}, \code{\link{polygon}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{aplot} \keyword{graphs} network/man/network.loop.Rd0000644000176200001440000000523013650471474015461 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.R \name{network.loop} \alias{network.loop} \title{Add Loops to a Plot} \usage{ network.loop( x0, y0, length = 0.1, angle = 10, width = 0.01, col = 1, border = 1, lty = 1, offset = 0, edge.steps = 10, radius = 1, arrowhead = TRUE, xctr = 0, yctr = 0, ... ) } \arguments{ \item{x0}{a vector of x coordinates for points of origin.} \item{y0}{a vector of y coordinates for points of origin.} \item{length}{arrowhead length, in current plotting units.} \item{angle}{arrowhead angle (in degrees).} \item{width}{width for loop body, in current plotting units (can be a vector).} \item{col}{loop body color (can be a vector).} \item{border}{loop border color (can be a vector).} \item{lty}{loop border line type (can be a vector).} \item{offset}{offset for origin point (can be a vector).} \item{edge.steps}{number of steps to use in approximating curves.} \item{radius}{loop radius (can be a vector).} \item{arrowhead}{boolean; should arrowheads be used? (Can be a vector.)} \item{xctr}{x coordinate for the central location away from which loops should be oriented.} \item{yctr}{y coordinate for the central location away from which loops should be oriented.} \item{\dots}{additional arguments to \code{\link{polygon}}.} } \value{ None. } \description{ \code{network.loop} draws a "loop" at a specified location; this is used to designate self-ties in \code{\link{plot.network}}. } \details{ \code{network.loop} is the companion to \code{\link{network.arrow}}; like the latter, plot elements produced by \code{network.loop} are drawn using \code{\link{polygon}}, and as such are scaled based on the current plotting device. By default, loops are drawn so as to encompass a circular region of radius \code{radius}, whose center is \code{offset} units from \code{x0,y0} and at maximum distance from \code{xctr,yctr}. This is useful for functions like \code{\link{plot.network}}, which need to draw loops incident to vertices of varying radii. } \note{ \code{network.loop} is a direct adaptation of \code{\link[sna]{gplot.loop}}, from the \code{sna} package. } \examples{ #Plot a few polygons with loops plot(0,0,type="n",xlim=c(-2,2),ylim=c(-2,2),asp=1) network.loop(c(0,0),c(1,-1),col=c(3,2),width=0.05,length=0.4, offset=sqrt(2)/4,angle=20,radius=0.5,edge.steps=50,arrowhead=TRUE) polygon(c(0.25,-0.25,-0.25,0.25,NA,0.25,-0.25,-0.25,0.25), c(1.25,1.25,0.75,0.75,NA,-1.25,-1.25,-0.75,-0.75),col=c(2,3)) } \seealso{ \code{\link{network.arrow}}, \code{\link{plot.network}}, \code{\link{polygon}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{aplot} \keyword{graphs} network/man/mixingmatrix.Rd0000644000176200001440000000666514057014734015547 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.R \name{mixingmatrix} \alias{mixingmatrix} \alias{mixingmatrix.network} \alias{[[.mixingmatrix} \alias{$.mixingmatrix} \alias{is.directed.mixingmatrix} \alias{is.bipartite.mixingmatrix} \alias{print.mixingmatrix} \title{Mixing matrix} \usage{ mixingmatrix(object, ...) \method{mixingmatrix}{network}(object, attrname, useNA = "ifany", expand.bipartite = FALSE, ...) \method{[[}{mixingmatrix}(x, ...) \method{$}{mixingmatrix}(x, name) \method{is.directed}{mixingmatrix}(x, ...) \method{is.bipartite}{mixingmatrix}(x, ...) \method{print}{mixingmatrix}(x, ...) } \arguments{ \item{object}{a network or some other data structure for which a mixing matrix is meaningful.} \item{...}{arguments passed to \code{\link{table}}.} \item{attrname}{a vertex attribute name.} \item{useNA}{one of "ifany", "no" or "always". Argument passed to \code{\link{table}}. By default (\code{useNA = "ifany"}) if there are any \code{NA}s on the attribute corresponding row \emph{and} column will be contained in the result. See Details.} \item{expand.bipartite}{logical; if \code{object} is bipartite, should we return the \emph{square} mixing matrix representing every level of \code{attrname} against every other level, or a \emph{rectangular} matrix considering only levels present in each bipartition?} \item{x}{mixingmatrix object} \item{name}{name of the element to extract, one of "matrix" or "type"} } \value{ Function \code{mixingmatrix()} returns an object of class \code{mixingmatrix} extending \code{table} with a cross-tabulation of edges in the \code{object} according to the values of attribute \code{attrname} for the two incident vertices. If \code{object} is a \emph{directed} network rows correspond to the "tie sender" and columns to the "tie receiver". If \code{object} is an \emph{undirected} network there is no such distinction and the matrix is symmetrized. In both cases the matrix is square and all the observed values of the attribute \code{attrname} are represented in rows and columns. If \code{object} is a \emph{bipartite} network and \code{expand.bipartite} is \code{FALSE} the resulting matrix does not have to be square as only the actually observed values of the attribute are shown for each partition, if \code{expand.bipartite} is \code{TRUE} the matrix will be square. Functions \code{is.directed()} and \code{is.bipartite()} return \code{TRUE} or \code{FALSE}. The values will be identical for the input network \code{object}. } \description{ Return the mixing matrix for a network, on a given attribute. } \details{ Handling of missing values on the attribute \code{attrname} almost follows similar logic to \code{\link{table}}. If there are \code{NA}s on the attribute and \code{useNA="ifany"} (default) the result will contain both row and column for the missing values to ensure the resulting matrix is square (essentially calling \code{\link{table}} with \code{useNA="always"}). Also for that reason passing \code{exclude} parameter with \code{NULL}, \code{NA} or \code{NaN} is ignored with a warning as it may break the symmetry. } \note{ The \code{$} and \code{[[} methods are included only for backward-compatiblity reason and will become defunct in future releases of the package. } \examples{ # Interaction ties between Lake Pomona SAR organizations by sponsorship type # of tie sender and receiver (data from Drabek et al. 1981) data(emon) mixingmatrix(emon$LakePomona, "Sponsorship") } network/man/network.density.Rd0000644000176200001440000000354514057075374016177 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.R \name{network.density} \alias{network.density} \title{Compute the Density of a Network} \usage{ network.density(x, na.omit = TRUE, discount.bipartite = FALSE) } \arguments{ \item{x}{an object of class \code{network}} \item{na.omit}{logical; omit missing edges from extant edges when assessing density?} \item{discount.bipartite}{logical; if \code{x} is bipartite, should \dQuote{forbidden} edges be excluded from the count of potential edges?} } \value{ The network density. } \description{ \code{network.density} computes the density of its argument. } \details{ The density of a network is defined as the ratio of extant edges to potential edges. We do not currently consider edge values; missing edges are omitted from extent (but not potential) edge count when \code{na.omit==TRUE}. } \section{Warning }{ \code{network.density} relies on network attributes (see \link{network.indicators}) to determine the properties of the underlying network object. If these are set incorrectly (e.g., multiple edges in a non-multiplex network, network coded with directed edges but set to \dQuote{undirected}, etc.), surprising results may ensue. } \examples{ #Create an arbitrary adjacency matrix m<-matrix(rbinom(25,1,0.5),5,5) diag(m)<-0 g<-network.initialize(5) #Initialize the network network.density(g) #Calculate the density } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} Wasserman, S. and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. } \seealso{ \code{\link{network.edgecount}}, \code{\link{network.size}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{graphs} network/man/flo.Rd0000644000176200001440000000173513566403644013606 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/network-package.R \name{flo} \alias{flo} \title{Florentine Wedding Data (Padgett)} \source{ Padgett, John F. (1994). \dQuote{Marriage and Elite Structure in Renaissance Florence, 1282-1500.} Paper delivered to the Social Science History Association. } \usage{ data(flo) } \description{ This is a data set of Padgett (1994), consisting of weddings among leading Florentine families. This data is stored in symmetric adjacency matrix form. } \examples{ data(flo) nflo<-network(flo,directed=FALSE) #Convert to network object form all(nflo[,]==flo) #Trust, but verify #A fancy display: plot(nflo,displaylabels=TRUE,boxed.labels=FALSE,label.cex=0.75) } \references{ Wasserman, S. and Faust, K. (1994) \emph{Social Network Analysis: Methods and Applications}, Cambridge: Cambridge University Press. } \seealso{ \code{\link{network}} } \keyword{datasets} network/man/add.vertices.Rd0000644000176200001440000000562014057075374015377 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{add.vertices} \alias{add.vertices} \alias{add.vertices.network} \title{Add Vertices to an Existing Network} \usage{ add.vertices(x, nv, vattr = NULL, last.mode = TRUE, ...) } \arguments{ \item{x}{an object of class \code{network}} \item{nv}{the number of vertices to add} \item{vattr}{optionally, a list of attributes with one entry per new vertex} \item{last.mode}{logical; should the new vertices be added to the last (rather than the first) mode of a bipartite network?} \item{...}{possible additional arguments to add.vertices} } \value{ Invisibly, a pointer to the updated \code{network} object; \code{add.vertices} modifies its argument in place. } \description{ \code{add.vertices} adds a specified number of vertices to an existing network; if desired, attributes for the new vertices may be specified as well. } \details{ New vertices are generally appended to the end of the network (i.e., their vertex IDs begin with \code{network.size(x)} an count upward). The one exception to this rule is when \code{x} is bipartite and \code{last.mode==FALSE}. In this case, new vertices are added to the end of the first mode, with existing second-mode vertices being permuted upward in ID. (\code{x}'s \code{bipartite} attribute is adjusted accordingly.) Note that the attribute format used here is based on the internal (vertex-wise) storage method, as opposed to the attribute-wise format used by \code{\link{network}}. Specifically, \code{vattr} should be a list with one entry per new vertex, the ith element of which should be a list with an element for every attribute of the ith vertex. (If the required \code{na} attribute is not given, it will be automatically created.) } \note{ \code{add.vertices} was converted to an S3 generic funtion in version 1.9, so it actually calls \code{add.vertices.network} by default and may call other versions depending on context (i.e. when called with a \code{networkDynamic} object). } \examples{ #Initialize a network object g<-network.initialize(5) g #Add five more vertices add.vertices(g,5) g #Create two more, with attributes vat<-replicate(2,list(is.added=TRUE,num.added=2),simplify=FALSE) add.vertices(g,2,vattr=vat) g\%v\%"is.added" #Values are only present for the new cases g\%v\%"num.added" #Add to a bipartite network bip <-network.initialize(5,bipartite=3) get.network.attribute(bip,'bipartite') # how many vertices in first mode? add.vertices(bip,3,last.mode=FALSE) get.network.attribute(bip,'bipartite') } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{network}}, \code{\link{get.vertex.attribute}}, \code{\link{set.vertex.attribute}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{classes} \keyword{graphs} network/man/network.extraction.Rd0000644000176200001440000001400214057075374016666 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{network.extraction} \alias{network.extraction} \alias{[.network} \alias{[<-.network} \alias{\%e\%} \alias{\%e\%<-} \alias{\%eattr\%} \alias{\%eattr\%<-} \alias{\%n\%} \alias{\%n\%<-} \alias{\%nattr\%} \alias{\%nattr\%<-} \alias{\%v\%} \alias{\%v\%<-} \alias{\%vattr\%} \alias{\%vattr\%<-} \title{Extraction and Replacement Operators for Network Objects} \usage{ \method{[}{network}(x, i, j, na.omit = FALSE) \method{[}{network}(x, i, j, names.eval = NULL, add.edges = FALSE) <- value x \%e\% attrname x \%e\% attrname <- value x \%eattr\% attrname x \%eattr\% attrname <- value x \%n\% attrname x \%n\% attrname <- value x \%nattr\% attrname x \%nattr\% attrname <- value x \%v\% attrname x \%v\% attrname <- value x \%vattr\% attrname x \%vattr\% attrname <- value } \arguments{ \item{x}{an object of class \code{network}.} \item{i, j}{indices of the vertices with respect to which adjacency is to be tested. Empty values indicate that all vertices should be employed (see below).} \item{na.omit}{logical; should missing edges be omitted (treated as no-adjacency), or should \code{NA}s be returned? (Default: return \code{NA} on missing.)} \item{names.eval}{optionally, the name of an edge attribute to use for assigning edge values.} \item{add.edges}{logical; should new edges be added to \code{x} where edges are absent and the appropriate element of \code{value} is non-zero?} \item{value}{the value (or set thereof) to be assigned to the selected element of \code{x}.} \item{attrname}{the name of a network or vertex attribute (as appropriate).} } \value{ The extracted data, or none. } \description{ Various operators which allow extraction or replacement of various components of a \code{network} object. } \details{ Indexing for edge extraction operates in a manner analogous to \code{matrix} objects. Thus, \code{x[,]} selects all vertex pairs, \code{x[1,-5]} selects the pairing of vertex 1 with all vertices except for 5, etc. Following this, it is acceptable for \code{i} and/or \code{j} to be logical vectors indicating which vertices are to be included. During assignment, an attempt is made to match the elements of \code{value} to the extracted pairs in an intelligent way; in particular, elements of \code{value} will be replicated if too few are supplied (allowing expressions like \code{x[1,]<-1}). Where \code{names.eval==NULL}, zero and non-zero values are taken to indicate the presence of absence of edges. \code{x[2,4]<-6} thus adds a single (2,4) edge to \code{x}, and \code{x[2,4]<-0} removes such an edge (if present). If \code{x} is multiplex, assigning 0 to a vertex pair will eliminate \emph{all} edges on that pair. Pairs are taken to be directed where \code{is.directed(x)==TRUE}, and undirected where \code{is.directed(x)==FALSE}. If an edge attribute is specified using \code{names.eval}, then the provided values will be assigned to that attribute. When assigning values, only extant edges are employed (unless \code{add.edges==TRUE}); in the latter case, any non-zero assignment results in the addition of an edge where currently absent. If the attribute specified is not present on a given edge, it is added. Otherwise, any existing value is overwritten. The \code{\%e\%} operator can also be used to extract/assign edge values; in those roles, it is respectively equivalent to \code{get.edge.value(x,attrname)} and \code{set.edge.value(x,attrname=attrname,value=value)} (if \code{value} is a matrix) and \code{set.edge.attribute(x,attrname=attrname,value=value)} (if \code{value} is anything else). That is, if \code{value} is a matrix, the assignment operator treats it as an adjacency matrix; and if not, it treats it as a vector (recycled as needed) in the internal ordering of edges (i.e., edge IDs), skipping over deleted edges. In no case will attributes be assigned to nonexisted edges. The \code{\%n\%} and \code{\%v\%} operators serve as front-ends to the network and vertex extraction/assignment functions (respectively). In the extraction case, \code{x \%n\% attrname} is equivalent to \code{get.network.attribute(x,attrname)}, with \code{x \%v\% attrname} corresponding to \code{get.vertex.attribute(x,attrname)}. In assignment, the respective equivalences are to \code{set.network.attribute(x,attrname,value)} and \code{set.vertex.attribute(x,attrname,value)}. Note that the \code{\%\%} assignment forms are generally slower than the named versions of the functions beause they will trigger an additional internal copy of the network object. The \code{\%eattr\%}, \code{\%nattr\%}, and \code{\%vattr\%} operators are equivalent to \code{\%e\%}, \code{\%n\%}, and \code{\%v\%} (respectively). The short forms are more succinct, but may produce less readable code. } \examples{ #Create a random graph (inefficiently) g<-network.initialize(10) g[,]<-matrix(rbinom(100,1,0.1),10,10) plot(g) #Demonstrate edge addition/deletion g[,]<-0 g[1,]<-1 g[2:3,6:7]<-1 g[,] #Set edge values g[,,names.eval="boo"]<-5 as.sociomatrix(g,"boo") #Assign edge values from a vector g \%e\% "hoo" <- "wah" g \%e\% "hoo" g \%e\% "om" <- c("wow","whee") g \%e\% "om" #Assign edge values as a sociomatrix g \%e\% "age" <- matrix(1:100, 10, 10) g \%e\% "age" as.sociomatrix(g,"age") #Set/retrieve network and vertex attributes g \%n\% "blah" <- "Pork!" #The other white meat? g \%n\% "blah" == "Pork!" #TRUE! g \%v\% "foo" <- letters[10:1] #Letter the vertices g \%v\% "foo" == letters[10:1] #All TRUE } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{is.adjacent}}, \code{\link{as.sociomatrix}}, \code{\link{attribute.methods}}, \code{\link{add.edges}}, \code{\link{network.operators}}, and \code{\link{get.inducedSubgraph}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{graphs} \keyword{manip} network/man/network.edgecount.Rd0000644000176200001440000000522314057075374016470 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{network.edgecount} \alias{network.edgecount} \alias{network.edgecount.network} \title{Return the Number of Edges in a Network Object} \usage{ \method{network.edgecount}{network}(x, na.omit = TRUE, ...) } \arguments{ \item{x}{an object of class \code{network}} \item{na.omit}{logical; omit edges with \code{na==TRUE} from the count?} \item{\dots}{additional arguments, used by extending functio} } \value{ The number of edges } \description{ \code{network.edgecount} returns the number of edges within a \code{network}, removing those flagged as missing if desired. } \details{ The return value is the number of distinct edges within the network object, including multiplex edges as appropriate. (So if there are 3 edges from vertex i to vertex j, each contributes to the total edge count.) The return value \code{network.edgecount} is in the present implementation related to the (required) \code{mnext} network attribute. \code{mnext} is an internal legacy attribute that currently indicates the index number of the next edge to be added to a network object. (Do not modify it unless you enjoy unfortunate surprises.) The number of edges returned by \code{network.edgecount} is equal to \code{x\%n\%"mnext"-1}, minus the number of \code{NULL} edges (and missing edges, if \code{na.omit==TRUE}). Note that \code{g\%n\%"mnext"-1} cannot, by itself, be counted upon to be an accurate count of the number of edges! As \code{mnext} is not part of the API (and is not guaranteed to remain), users and developers are urged to use \code{network.edgecount} instead. } \section{Warning }{ \code{network.edgecount} uses the real state of the network object to count edges, not the state it hypothetically should have. Thus, if you add extra edges to a non-multiplex network, directed edges to an undirected network, etc., the actual number of edges in the object will be returned (and not the number you would expect if you relied only on the putative number of possible edges as reflected by the \link{network.indicators}). Don't create \code{network} objects with contradictory attributes unless you know what you are doing. } \examples{ #Create a network with three edges m<-matrix(0,3,3) m[1,2]<-1; m[2,3]<-1; m[3,1]<-1 g<-network(m) network.edgecount(g)==3 #Verify the edgecount } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{get.network.attribute}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{classes} \keyword{graphs} network/man/as.edgelist.Rd0000644000176200001440000000706313650471474015230 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/as.edgelist.R \name{as.edgelist} \alias{as.edgelist} \alias{as.edgelist.network} \alias{edgelist} \alias{as.edgelist.matrix} \alias{as.edgelist.tbl_df} \alias{is.edgelist} \title{Convert a network object into a numeric edgelist matrix} \usage{ \method{as.edgelist}{network}( x, attrname = NULL, as.sna.edgelist = FALSE, output = c("matrix", "tibble"), ... ) \method{as.edgelist}{matrix}( x, n, directed = TRUE, bipartite = FALSE, loops = FALSE, vnames = seq_len(n), ... ) \method{as.edgelist}{tbl_df}( x, n, directed = TRUE, bipartite = FALSE, loops = FALSE, vnames = seq_len(n), ... ) is.edgelist(x) } \arguments{ \item{x}{a \code{network} object with additional class added indicating how it should be dispatched.} \item{attrname}{optionally, the name of an edge attribute to use for edge values; may be a vector of names if \code{output="tibble"}} \item{as.sna.edgelist}{logical; should the edgelist be returned in edgelist form expected by the sna package? Ignored if \code{output="tibble"}} \item{output}{return type: a \code{\link{matrix}} or a \code{\link{tibble}}; see \code{\link{as.matrix.network}} for the difference.} \item{\dots}{additional arguments to other methods} \item{n}{integer number of vertices in network, value passed to the 'n' flag on edgelist returned} \item{directed}{logical; is network directed, value passed to the 'directed' flag on edgelist returned} \item{bipartite}{logical or integer; is network bipartite, value passed to the 'bipartite' flag on edgelist returned} \item{loops}{logical; are self-loops allowed in network?, value passed to the 'loops' flag on edgelist returned} \item{vnames}{vertex names (defaults to vertex ids) to be attached to edgelist for sna package compatibility} } \value{ A matrix in which the first two columns are integers giving the tail (source) and head (target) vertex ids of each edge. The matrix will be given the class \code{edgelist}. The edgelist has additional attributes attached to it: \itemize{ \item \code{attr(,"n")} the number of vertices in the original network \item \code{attr(,"vnames")} the names of vertices in the original network \item \code{attr(,"directed")} logical, was the original network directed \item \code{attr(,"bipartite")} was the original network bipartite \item \code{attr(,"loops")} does the original network contain self-loops } Note that if the \code{attrname} attribute is used the resulting edgelist matrix will have three columns. And if \code{attrname} refers to a character attribute, the resulting edgelist matrix will be character rather than numeric unless \code{output="tibble"}. } \description{ Constructs an edgelist in a sorted format with defined attributes. } \details{ Constructs a edgelist matrix or tibble from a network, sorted tails-major order, with tails first, and, for undirected networks, tail < head. This format is required by some reverse-depending packages (e.g. \code{ergm}) The \code{\link{as.matrix.network.edgelist}} provides similar functionality but it does not enforce ordering or set the \code{edgelist} class and so should be slightly faster. \code{is.edgelist} tests if an object has the class \code{'edgelist'} } \note{ NOTE: this function was moved to network from the ergm package in network version 1.13 } \examples{ data(emon) as.edgelist(emon[[1]]) as.edgelist(emon[[1]],output="tibble") # contrast with unsorted columns of as.matrix.network.edgelist(emon[[1]]) } \seealso{ See also \code{\link{as.matrix.network.edgelist}} } network/man/network.initialize.Rd0000644000176200001440000000325714057075374016661 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/constructors.R \name{network.initialize} \alias{network.initialize} \title{Initialize a Network Class Object} \usage{ network.initialize( n, directed = TRUE, hyper = FALSE, loops = FALSE, multiple = FALSE, bipartite = FALSE ) } \arguments{ \item{n}{the number of vertices to initialize} \item{directed}{logical; should edges be interpreted as directed?} \item{hyper}{logical; are hyperedges allowed?} \item{loops}{logical; should loops be allowed?} \item{multiple}{logical; are multiplex edges allowed?} \item{bipartite}{count; should the network be interpreted as bipartite? If present (i.e., non-NULL) it is the count of the number of actors in the first mode of the bipartite network. In this case, the overall number of vertices is equal to the number of 'actors' (first mode) plus the number of `events' (second mode), with the vertex.ids of all actors preceeding all events. The edges are then interpreted as nondirected.} } \value{ An object of class \code{network} } \description{ Create and initialize a \code{network} object with \code{n} vertices. } \details{ Generally, \code{network.initialize} is called by other constructor functions as part of the process of creating a network. } \examples{ g<-network.initialize(5) #Create an empty graph on 5 vertices } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{network}}, \code{\link{as.network.matrix}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{classes} \keyword{graphs} network/man/as.matrix.network.Rd0000644000176200001440000001334614057075374016426 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/coercion.R \name{as.matrix.network} \alias{as.matrix.network} \alias{as.matrix.network.adjacency} \alias{as.matrix.network.edgelist} \alias{as_tibble.network} \alias{as.tibble.network} \alias{as.matrix.network.incidence} \title{Coerce a Network Object to Matrix or Table Form} \usage{ \method{as.matrix}{network}(x, matrix.type = NULL, attrname = NULL, ...) \method{as.matrix.network}{adjacency}(x, attrname=NULL, expand.bipartite = FALSE, ...) \method{as.matrix.network}{edgelist}(x, attrname=NULL, as.sna.edgelist = FALSE, na.rm = TRUE, ...) \method{as_tibble}{network}( x, attrnames = (match.arg(unit) == "vertices"), na.rm = TRUE, ..., unit = c("edges", "vertices"), store.eid = FALSE ) as.tibble.network( x, attrnames = (match.arg(unit) == "vertices"), na.rm = TRUE, ..., unit = c("edges", "vertices"), store.eid = FALSE ) \method{as.matrix.network}{incidence}(x, attrname=NULL, ...) } \arguments{ \item{x}{an object of class \code{network}} \item{matrix.type}{one of \code{"adjacency"}, \code{"incidence"}, \code{"edgelist"}, or \code{NULL}} \item{attrname}{optionally, the name of an edge attribute to use for edge values} \item{...}{additional arguments.} \item{expand.bipartite}{logical; if \code{x} is bipartite, should we return the full adjacency matrix (rather than the abbreviated, two-mode form)?} \item{as.sna.edgelist}{logical; should the edgelist be returned in sna edglist form?} \item{na.rm}{logical; should missing edges/vertices be included in the edgelist formats? Ignored if \code{as.sna.edgelist=TRUE}.} \item{attrnames}{optionally, either a character vector of the names of edge attributes to use for edge values, or a numerical or logical vector to use as indices for selecting them from \code{\link{list.edge.attributes}(x)} or \code{\link{list.vertex.attributes}(x)} (depending on \code{unit}); passing \code{TRUE} therefore returns all edge attributes as columns} \item{unit}{whether a \code{\link{tibble}} of edge or vertex attributes should be returned.} \item{store.eid}{whether the edge ID should be stored in the third column (\code{.eid}).} } \value{ For \code{as.matrix} methods, an adjacency, incidence, or edgelist matrix. For the \code{as_tibble} method, a \code{tibble} whose first two columns are \code{.head} and \code{.tail}, whose third column \code{.eid} is the edge ID, and whose subsequent columns are the requested edge attributes. } \description{ The \code{as.matrix} methods attempt to coerce their input to a matrix in adjacency, incidence, or edgelist form. Edge values (from a stored attribute) may be used if present. \code{\link[tibble:as_tibble]{as_tibble}} coerces into an edgelist in \code{\link{tibble}} (a type of \code{\link{data.frame}}) form; this can be especially useful if extrecting a character-type edge attribute. } \details{ If no matrix type is specified, \code{\link{which.matrix.type}} will be used to make an educated guess based on the shape of \code{x}. Where edge values are not specified, a dichotomous matrix will be assumed. Edgelists returned by the \code{as.matrix} methods are by default in a slightly different form from the \code{sna} edgelist standard, but do contain the \code{sna} extended matrix attributes (see \code{\link{as.network.matrix}}). They should typically be compatible with \code{sna} library functions. To ensure compatibility, the \code{as.sna.edgelist} argument can be set (which returns an exact \code{sna} edgelist). The \code{\link{as.edgelist}} function also returns a similar edgelist matrix but with an enforced sorting. For the \code{as.matrix} methods, if the \code{attrname} attribute is used to include a charcter attribute, the resulting edgelist matrix will be character rather than numeric. The \code{as_tibble} methods never coerce. Note that adjacency matrices may also be obtained using the extraction operator. See the relevant man page for details. Also note that which attributes get returned by the \code{as_tibble} method by default depends on \code{unit}: by default no edge attributes are returned but all vertex attributes are. } \examples{ # Create a random network m <- matrix(rbinom(25,4,0.159),5,5) # 50\% density diag(m) <- 0 g <- network(m, ignore.eval=FALSE, names.eval="a") # With values g \%e\% "ac" <- letters[g \%e\% "a"] # Coerce to matrix form # No attributes: as.matrix(g,matrix.type="adjacency") as.matrix(g,matrix.type="incidence") as.matrix(g,matrix.type="edgelist") # Attributes: as.matrix(g,matrix.type="adjacency",attrname="a") as.matrix(g,matrix.type="incidence",attrname="a") as.matrix(g,matrix.type="edgelist",attrname="a") as.matrix(g,matrix.type="edgelist",attrname="ac") # Coerce to a tibble: library(tibble) as_tibble(g) as_tibble(g, attrnames=c("a","ac")) as_tibble(g, attrnames=TRUE) # Get vertex attributes instead: as_tibble(g, unit = "vertices") # Missing data handling: g[1,2] <- NA as.matrix(g,matrix.type="adjacency") # NA in the corresponding cell as.matrix(g,matrix.type="edgelist", na.rm=TRUE) # (1,2) excluded as.matrix(g,matrix.type="edgelist", na.rm=FALSE) # (1,2) included as_tibble(g, attrnames="na", na.rm=FALSE) # Which edges are marked missing? # Can also use the extraction operator g[,] # Get entire adjacency matrix g[1:2,3:5] # Obtain a submatrix } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{which.matrix.type}}, \code{\link{network}}, \code{\link{network.extraction}},\code{\link{as.edgelist}} } \author{ Carter T. Butts \email{buttsc@uci.edu} and David Hunter \email{dhunter@stat.psu.edu} } \keyword{classes} \keyword{graphs} network/man/emon.Rd0000644000176200001440000001043714057014734013755 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/network-package.R \docType{data} \name{emon} \alias{emon} \title{Interorganizational Search and Rescue Networks (Drabek et al.)} \format{ A list of 7 \code{\link{network}} objects: \tabular{rlll}{ \verb{[[1]]} \tab Cheyenne \tab network \tab Cheyenne SAR EMON\cr \verb{[[2]]} \tab HurrFrederic \tab network \tab Hurricane Frederic SAR EMON\cr \verb{[[3]]} \tab LakePomona \tab network \tab Lake Pomona SAR EMON\cr \verb{[[4]]} \tab MtSi \tab network \tab Mt. Si SAR EMON\cr \verb{[[5]]} \tab MtStHelens \tab network \tab Mt. St. Helens SAR EMON\cr \verb{[[6]]} \tab Texas \tab network \tab Texas Hill Country SAR EMON\cr \verb{[[7]]} \tab Wichita \tab network \tab Wichita Falls SAR EMON } Each network has one edge attribute: \tabular{lll}{ Frequency \tab numeric \tab Interaction frequency (1-4; 1=most frequent) } Each network also has 8 vertex attributes: \tabular{lll}{ Command.Rank.Score \tab numeric \tab Mean rank in the command structure\cr Decision.Rank.Score \tab numeric \tab Mean rank in the decision process\cr Formalization \tab numeric \tab Degree of formalization\cr Location \tab character \tab Location code\cr Paid.Staff \tab numeric \tab Number of paid staff\cr Sponsorship \tab character \tab Sponsorship type\cr vertex.names \tab character \tab Organization name\cr Volunteer.Staff \tab numeric \tab Number of volunteer staff } } \source{ Drabek, T.E.; Tamminga, H.L.; Kilijanek, T.S.; and Adams, C.R. (1981). \emph{Data from Managing Multiorganizational Emergency Responses: Emergent Search and Rescue Networks in Natural Disaster and Remote Area Settings.} Program on Technology, Environment, and Man Monograph 33. Institute for Behavioral Science, University of Colorado. } \usage{ data(emon) } \description{ Drabek et al. (1981) provide seven case studies of emergent multi-organizational networks (EMONs) in the context of search and rescue (SAR) activities. Networks of interaction frequency are reported, along with several organizational attributes. } \details{ All networks collected by Drabek et al. reflect reported frequency of organizational interaction during the search and rescue effort; the (i,j) edge constitutes i's report regarding interaction with j, with non-adjacent vertices reporting no contact. Frequency is rated on a four-point scale, with 1 indicating the highest frequency of interaction. (Response options: 1=\dQuote{continuously}, 2=\dQuote{about once an hour}, 3=\dQuote{every few hours}, 4=\dQuote{about once a day or less}) This is stored within the \code{"Frequency"} edge attribute. For each network, several covariates are recorded as vertex attributes: \describe{ \item{Command.Rank.Score}{ Mean (reversed) rank for the prominence of each organization in the command structure of the response, as judged by organizational informants.} \item{Decision.Rank.Score}{ Mean (reversed) rank for the prominence of each organization in decision making processes during the response, as judged by organizational informants.} \item{Formalization}{ An index of organizational formalization, ranging from 0 (least formalized) to 4 (most formalized).} \item{Localization}{ For each organization, \code{"L"} if the organization was sited locally to the impact area, \code{"NL"} if the organization was not sited near the impact area, \code{"B"} if the organization was sited at both local and non-local locations.} \item{Paid.Staff}{ Number of paid staff employed by each organization at the time of the response.} \item{Sponsorship}{ The level at which each organization was sponsored (e.g., \code{"City"}, \code{"County"}, \code{"State"}, \code{"Federal"}, and \code{"Private"}).} \item{vertex.names}{ The identity of each organization.} \item{Volunteer.Staff}{ Number of volunteer staff employed by each organization at the time of the response.} } Note that where intervals were given by the original source, midpoints have been substituted. For detailed information regarding data coding and procedures, see Drabek et al. (1981). } \examples{ data(emon) #Load the emon data set #Plot the EMONs par(mfrow=c(3,3)) for(i in 1:length(emon)) plot(emon[[i]],main=names(emon)[i],edge.lwd="Frequency") } \seealso{ \code{\link{network}} } \keyword{datasets} network/man/network.size.Rd0000644000176200001440000000167014057075374015467 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{network.size} \alias{network.size} \title{Return the Size of a Network} \usage{ network.size(x, ...) } \arguments{ \item{x}{an object of class \code{network}} \item{\dots}{additional arguments, not used} } \value{ The network size } \description{ \code{network.size} returns the order of its argument (i.e., number of vertices). } \details{ \code{network.size(x)} is equivalent to \code{get.network.attribute(x,"n")}; the function exists as a convenience. } \examples{ #Initialize a network g<-network.initialize(7) network.size(g) } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{get.network.attribute}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{classes} \keyword{graphs} network/man/has.edges.Rd0000644000176200001440000000144613566403644014666 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.R \name{has.edges} \alias{has.edges} \alias{is.isolate} \title{Determine if specified vertices of a network have any edges (are not isolates)} \usage{ has.edges(net, v = seq_len(network.size(net))) } \arguments{ \item{net}{a \code{\link{network}} object to be queried} \item{v}{integer vector of vertex ids to check} } \value{ returns a logical vector with the same length as v, with TRUE if the vertex is involved in any edges, FALSE if it is an isolate. } \description{ Returns a logical value for each specified vertex, indicating if it has any incident (in or out) edges. Checks all vertices by default } \examples{ test<-network.initialize(5) test[1,2]<-1 has.edges(test) has.edges(test,v=5) } \author{ skyebend } network/man/network.Rd0000644000176200001440000002453614057075374014524 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R, R/coercion.R, R/constructors.R, % R/dataframe.R, R/printsum.R \name{network} \alias{network} \alias{is.network} \alias{as.network.network} \alias{print.summary.network} \alias{$<-.network} \alias{<-.network} \alias{as.network} \alias{network.copy} \alias{as.network.data.frame} \alias{print.network} \alias{summary.network} \title{Network Objects} \usage{ is.network(x) as.network(x, ...) network( x, vertex.attr = NULL, vertex.attrnames = NULL, directed = TRUE, hyper = FALSE, loops = FALSE, multiple = FALSE, bipartite = FALSE, ... ) network.copy(x) \method{as.network}{data.frame}( x, directed = TRUE, vertices = NULL, hyper = FALSE, loops = FALSE, multiple = FALSE, bipartite = FALSE, bipartite_col = "is_actor", ... ) \method{print}{network}( x, matrix.type = which.matrix.type(x), mixingmatrices = FALSE, na.omit = TRUE, print.adj = FALSE, ... ) \method{summary}{network}(object, na.omit = TRUE, mixingmatrices = FALSE, print.adj = TRUE, ...) } \arguments{ \item{x}{for \code{network}, a matrix giving the network structure in adjacency, incidence, or edgelist form; otherwise, an object of class \code{network}.} \item{...}{additional arguments.} \item{vertex.attr}{optionally, a list containing vertex attributes.} \item{vertex.attrnames}{optionally, a list containing vertex attribute names.} \item{directed}{logical; should edges be interpreted as directed?} \item{hyper}{logical; are hyperedges allowed?} \item{loops}{logical; should loops be allowed?} \item{multiple}{logical; are multiplex edges allowed?} \item{bipartite}{count; should the network be interpreted as bipartite? If present (i.e., non-NULL, non-FALSE) it is the count of the number of actors in the bipartite network. In this case, the number of nodes is equal to the number of actors plus the number of events (with all actors preceeding all events). The edges are then interpreted as nondirected. Values of bipartite==0 are permited, indicating a bipartite network with zero-sized first partition.} \item{vertices}{If \code{x} is a \code{data.frame}, \code{vertices} is an optional \code{data.frame} containing the vertex attributes. The first column is assigned to the \code{"vertex.names"} and additional columns are used to set vertex attributes using their column names. If \code{bipartite} is \code{TRUE}, a \code{logical} column named \code{"is_actor"} (or the name of a column specified using the \code{bipartite_col} parameter) can be provided indicating which vertices should be considered as actors. If not provided, vertices referenced in the first column of \code{x} are assumed to be the network's actors. If your network has isolates (i.e. there are vertices referenced in \code{vertices} that are not referenced in \code{x}), the \code{"is_actor"} column is required.} \item{bipartite_col}{\code{character(1L)}, default: \code{"is_actor"}. The name of the \code{logical} column indicating which vertices should be considered as actors in bipartite networks.} \item{matrix.type}{one of \code{"adjacency"}, \code{"edgelist"}, \code{"incidence"}. See \code{\link{edgeset.constructors}} for details and optional additional arguments} \item{mixingmatrices}{logical; print the mixing matrices for the discrete attributes?} \item{na.omit}{logical; omit summarization of missing attributes in \code{network}?} \item{print.adj}{logical; print the network adjacency structure?} \item{object}{an object of class \code{network}.} } \value{ \code{network}, \code{as.network}, and \code{print.network} all return a network class object; \code{is.network} returns TRUE or FALSE. } \description{ Construct, coerce to, test for and print \code{network} objects. } \details{ \code{network} constructs a \code{network} class object from a matrix representation. If the \code{matrix.type} parameter is not specified, it will make a guess as to the intended \code{edgeset.constructors} function to call based on the format of these input matrices. If the class of \code{x} is not a matrix, network construction can be dispatched to other methods. For example, If the \code{ergm} package is loaded, \code{network()} can function as a shorthand for \code{as.network.numeric} with \code{x} as an integer specifying the number of nodes to be created in the random graph. If the \code{ergm} package is loaded, \code{network} can function as a shorthand for \code{as.network.numeric} if \code{x} is an integer specifying the number of nodes. See the help page for \code{as.network.numeric} in \code{ergm} package for details. \code{network.copy} creates a new \code{network} object which duplicates its supplied argument. (Direct assignment with \code{<-} should be used rather than \code{network.copy} in most cases.) \code{as.network} tries to coerce its argument to a network, using the \code{as.network.matrix} functions if \code{x} is a matrix. (If the argument is already a network object, it is returned as-is and all other arguments are ignored.) \code{is.network} tests whether its argument is a network (in the sense that it has class \code{network}). \code{print.network} prints a network object in one of several possible formats. It also prints the list of global attributes of the network. \code{summary.network} provides similar information. } \note{ Between versions 0.5 and 1.2, direct assignment of a network object created a pointer to the original object, rather than a copy. As of version 1.2, direct assignment behaves in the same manner as \code{network.copy}. Direct use of the latter is thus superfluous in most situations, and is discouraged. Many of the network package functions modify their network object arguments in-place. For example, \code{set.network.attribute(net,"myVal",5)} will have the same effect as \code{net<-set.network.attribute(net,"myVal",5)}. Unfortunately, the current implementation of in-place assignment breaks when the network argument is an element of a list or a named part of another object. So \code{set.network.attribute(myListOfNetworks[[1]],"myVal",5)} will silently fail to modify its network argument, likely leading to incorrect output. } \examples{ m <- matrix(rbinom(25,1,.4),5,5) diag(m) <- 0 g <- network(m, directed=FALSE) summary(g) h <- network.copy(g) #Note: same as h<-g summary(h) # networks from data frames =========================================================== #* simple networks ==================================================================== simple_edge_df <- data.frame( from = c("b", "c", "c", "d", "a"), to = c("a", "b", "a", "a", "b"), weight = c(1, 1, 2, 2, 3), stringsAsFactors = FALSE ) simple_edge_df as.network(simple_edge_df) # simple networks with vertices ======================================================= simple_vertex_df <- data.frame( name = letters[1:5], residence = c("urban", "rural", "suburban", "suburban", "rural"), stringsAsFactors = FALSE ) simple_vertex_df as.network(simple_edge_df, vertices = simple_vertex_df) as.network(simple_edge_df, directed = FALSE, vertices = simple_vertex_df, multiple = TRUE ) #* splitting multiplex data frames into multiple networks ============================= simple_edge_df$relationship <- c(rep("friends", 3), rep("colleagues", 2)) simple_edge_df lapply(split(simple_edge_df, f = simple_edge_df$relationship), as.network, vertices = simple_vertex_df ) #* bipartite networks without isolates ================================================ bip_edge_df <- data.frame( actor = c("a", "a", "b", "b", "c", "d", "d", "e"), event = c("e1", "e2", "e1", "e3", "e3", "e2", "e3", "e1"), actor_enjoyed_event = rep(c(TRUE, FALSE), 4), stringsAsFactors = FALSE ) bip_edge_df bip_node_df <- data.frame( node_id = c("a", "e1", "b", "e2", "c", "e3", "d", "e"), node_type = c( "person", "event", "person", "event", "person", "event", "person", "person" ), color = c( "red", "blue", "red", "blue", "red", "blue", "red", "red" ), stringsAsFactors = FALSE ) bip_node_df as.network(bip_edge_df, directed = FALSE, bipartite = TRUE) as.network(bip_edge_df, directed = FALSE, vertices = bip_node_df, bipartite = TRUE) #* bipartite networks with isolates =================================================== bip_nodes_with_isolates <- rbind( bip_node_df, data.frame( node_id = c("f", "e4"), node_type = c("person", "event"), color = c("red", "blue"), stringsAsFactors = FALSE ) ) # indicate which vertices are actors via a column named `"is_actor"` bip_nodes_with_isolates$is_actor <- bip_nodes_with_isolates$node_type == "person" bip_nodes_with_isolates as.network(bip_edge_df, directed = FALSE, vertices = bip_nodes_with_isolates, bipartite = TRUE ) #* hyper networks from data frames ==================================================== hyper_edge_df <- data.frame( from = c("a/b", "b/c", "c/d/e", "d/e"), to = c("c/d", "a/b/e/d", "a/b", "d/e"), time = 1:4, stringsAsFactors = FALSE ) tibble::as_tibble(hyper_edge_df) # split "from" and "to" at `"/"`, coercing them to list columns hyper_edge_df$from <- strsplit(hyper_edge_df$from, split = "/") hyper_edge_df$to <- strsplit(hyper_edge_df$to, split = "/") tibble::as_tibble(hyper_edge_df) as.network(hyper_edge_df, directed = FALSE, vertices = simple_vertex_df, hyper = TRUE, loops = TRUE ) # convert network objects back to data frames ========================================= simple_g <- as.network(simple_edge_df, vertices = simple_vertex_df) as.data.frame(simple_g) as.data.frame(simple_g, unit = "vertices") bip_g <- as.network(bip_edge_df, directed = FALSE, vertices = bip_node_df, bipartite = TRUE ) as.data.frame(bip_g) as.data.frame(bip_g, unit = "vertices") hyper_g <- as.network(hyper_edge_df, directed = FALSE, vertices = simple_vertex_df, hyper = TRUE, loops = TRUE ) as.data.frame(hyper_g) as.data.frame(hyper_g, unit = "vertices") } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{network.initialize}}, \code{\link{attribute.methods}}, \code{\link{as.network.matrix}}, \code{\link{as.matrix.network}}, \code{\link{deletion.methods}}, \code{\link{edgeset.constructors}}, \code{\link{network.indicators}}, \code{\link{plot.network}} } \author{ Carter T. Butts \email{buttsc@uci.edu} and David Hunter \email{dhunter@stat.psu.edu} } \keyword{classes} \keyword{graphs} network/man/edgeset.constructors.Rd0000644000176200001440000001017314057075374017212 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/constructors.R \name{edgeset.constructors} \alias{edgeset.constructors} \alias{network.bipartite} \alias{network.adjacency} \alias{network.edgelist} \alias{network.incidence} \title{Edgeset Constructors for Network Objects} \usage{ network.bipartite(x, g, ignore.eval = TRUE, names.eval = NULL, ...) network.adjacency(x, g, ignore.eval = TRUE, names.eval = NULL, ...) network.edgelist(x, g, ignore.eval = TRUE, names.eval = NULL, ...) network.incidence(x, g, ignore.eval = TRUE, names.eval = NULL, ...) } \arguments{ \item{x}{a matrix containing edge information} \item{g}{an object of class \code{network}} \item{ignore.eval}{logical; ignore edge value information in x?} \item{names.eval}{a name for the edge attribute under which to store edge values, if any} \item{\dots}{possible additional arguments (such as \code{edge.check})} } \value{ Invisibly, an object of class \code{network}; these functions modify their argument in place. } \description{ These functions convert relational data in matrix form to network edge sets. } \details{ Each of the above functions takes a \code{network} and a matrix as input, and modifies the supplied \code{network} object by adding the appropriate edges. \code{network.adjacency} takes \code{x} to be an adjacency matrix; \code{network.edgelist} takes \code{x} to be an edgelist matrix; and \code{network.incidence} takes \code{x} to be an incidence matrix. \code{network.bipartite} takes \code{x} to be a two-mode adjacency matrix where rows and columns reflect each respective mode (conventionally, actors and events); If \code{ignore.eval==FALSE}, (non-zero) edge values are stored as edgewise attributes with name \code{names.eval}. The \code{edge.check} argument can be added via \code{\dots} and will be passed to \code{\link{add.edges}}. Edgelist matrices to be used with \code{network.edgelist} should have one row per edge, with the first two columns indicating the sender and receiver of each edge (respectively). Edge values may be provided in additional columns. The edge attributes will be created with names corresponding to the column names unless alternate names are provided via \code{names.eval}. The vertices specified in the first two columns, which can be characters, are added to the network in default sort order. The edges are added in the order specified by the edgelist matrix. Incidence matrices should contain one row per vertex, with one column per edge. A non-zero entry in the matrix means that the edge with the id corresponding to the column index will have an incident vertex with an id corresponding to the row index. In the directed case, negative cell values are taken to indicate tail vertices, while positive values indicate head vertices. Results similar to \code{network.adjacency} can also be obtained by means of extraction/replacement operators. See the associated man page for details. } \examples{ #Create an arbitrary adjacency matrix m<-matrix(rbinom(25,1,0.5),5,5) diag(m)<-0 g<-network.initialize(5) #Initialize the network network.adjacency(m,g) #Import the edge data #Do the same thing, using replacement operators g<-network.initialize(5) g[,]<-m # load edges from a data.frame via network.edgelist edata <-data.frame( tails=c(1,2,3), heads=c(2,3,1), love=c('yes','no','maybe'), hate=c(3,-5,2), stringsAsFactors=FALSE ) g<-network.edgelist(edata,network.initialize(4),ignore.eval=FALSE) as.sociomatrix(g,attrname='hate') g\%e\%'love' # load edges from an incidence matrix inci<-matrix(c(1,1,0,0, 0,1,1,0, 1,0,1,0),ncol=3,byrow=FALSE) inci g<-network.incidence(inci,network.initialize(4,directed=FALSE)) as.matrix(g) } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{loading.attributes}}, \code{\link{network}}, \code{\link{network.initialize}}, \code{\link{add.edges}}, \code{\link{network.extraction}} } \author{ Carter T. Butts \email{buttsc@uci.edu} and David Hunter \email{dhunter@stat.psu.edu} } \keyword{classes} \keyword{graphs} network/man/as.data.frame.network.Rd0000644000176200001440000000153713737227152017120 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dataframe.R \name{as.data.frame.network} \alias{as.data.frame.network} \title{Coerce a Network Object to a \code{data.frame}} \usage{ \method{as.data.frame}{network}( x, ..., unit = c("edges", "vertices"), na.rm = TRUE, attrs_to_ignore = "na" ) } \arguments{ \item{x}{an object of class \code{network}} \item{...}{additional arguments} \item{unit}{whether a \code{data.frame} of edge or vertex attributes should be returned.} \item{na.rm}{logical; ignore missing entries when constructing the data frame?} \item{attrs_to_ignore}{character; a vector of attribute names to exclude from the returned \code{data.frame} (Default: \code{"na"})} } \description{ The \code{as.data.frame} method coerces its input to a \code{data.frame} containing \code{x}'s edges or vertices. } network/man/network.indicators.Rd0000644000176200001440000000530714057075374016655 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{network.indicators} \alias{network.indicators} \alias{has.loops} \alias{is.bipartite} \alias{is.bipartite.network} \alias{is.directed} \alias{is.directed.network} \alias{is.hyper} \alias{is.multiplex} \title{Indicator Functions for Network Properties} \usage{ has.loops(x) is.bipartite(x, ...) \method{is.bipartite}{network}(x, ...) is.directed(x, ...) \method{is.directed}{network}(x, ...) is.hyper(x) is.multiplex(x) } \arguments{ \item{x}{an object of class \code{network}} \item{...}{other arguments passed to/from other methods} } \value{ \code{TRUE} or \code{FALSE} } \description{ Various indicators for properties of \code{network} class objects. } \details{ These methods are the standard means of assessing the state of a \code{network} object; other methods can (and should) use these routines in governing their own behavior. As such, improper setting of the associated attributes may result in unpleasantly creative results. (See the \code{edge.check} argument to \code{\link{add.edges}} for an example of code which makes use of these network properties.) The functions themselves behave has follows: \code{has.loops} returns \code{TRUE} iff \code{x} is allowed to contain loops (or loop-like edges, in the hypergraphic case). \code{is.bipartite} returns \code{TRUE} iff the \code{x} has been explicitly bipartite-coded. Values of \code{bipartite=NULL}, and \code{bipartite=FALSE} will evaluate to \code{FALSE}, numeric values of \code{bipartite>=0} will evaluate to \code{TRUE}. (The value \code{bipartite==0} indicates that it is a bipartite network with a zero-sized first partition.) Note that \code{is.bipartite} refers only to the storage properties of \code{x} and how it should be treated by some algorithms; \code{is.bipartite(x)==FALSE} it does \emph{not} mean that \code{x} cannot admit a bipartition! \code{is.directed} returns \code{TRUE} iff the edges of \code{x} are to be interpreted as directed. \code{is.hyper} returns \code{TRUE} iff \code{x} is allowed to contain hypergraphic edges. \code{is.multiplex} returns \code{TRUE} iff \code{x} is allowed to contain multiplex edges. } \examples{ g<-network.initialize(5) #Initialize the network is.bipartite(g) is.directed(g) is.hyper(g) is.multiplex(g) has.loops(g) } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{network}}, \code{\link{get.network.attribute}}, \code{set.network.attribute}, \code{\link{add.edges}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{classes} \keyword{graphs} network/man/attribute.methods.Rd0000644000176200001440000002253314057075374016473 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{attribute.methods} \alias{attribute.methods} \alias{delete.edge.attribute} \alias{delete.edge.attribute.network} \alias{delete.network.attribute} \alias{delete.network.attribute.network} \alias{delete.vertex.attribute} \alias{delete.vertex.attribute.network} \alias{get.edge.attribute} \alias{get.edge.attribute.network} \alias{get.edge.attribute.list} \alias{get.edge.value} \alias{get.edge.value.network} \alias{get.edge.value.list} \alias{get.network.attribute} \alias{get.network.attribute.network} \alias{get.vertex.attribute} \alias{get.vertex.attribute.network} \alias{list.edge.attributes} \alias{list.edge.attributes.network} \alias{list.network.attributes} \alias{list.network.attributes.network} \alias{list.vertex.attributes} \alias{list.vertex.attributes.network} \alias{network.vertex.names} \alias{network.vertex.names<-} \alias{set.edge.attribute} \alias{set.edge.attribute.network} \alias{set.edge.value} \alias{set.edge.value.network} \alias{set.network.attribute} \alias{set.network.attribute.network} \alias{set.vertex.attribute} \alias{set.vertex.attribute.network} \title{Attribute Interface Methods for the Network Class} \usage{ delete.edge.attribute(x, attrname, ...) \method{delete.edge.attribute}{network}(x, attrname, ...) delete.network.attribute(x, attrname, ...) \method{delete.network.attribute}{network}(x, attrname, ...) delete.vertex.attribute(x, attrname, ...) \method{delete.vertex.attribute}{network}(x, attrname, ...) get.edge.attribute(x, ..., el) \method{get.edge.attribute}{network}( x, attrname, unlist = TRUE, na.omit = FALSE, null.na = FALSE, deleted.edges.omit = FALSE, ..., el ) \method{get.edge.attribute}{list}( x, attrname, unlist = TRUE, na.omit = FALSE, null.na = FALSE, deleted.edges.omit = FALSE, ..., el ) get.edge.value(x, ...) \method{get.edge.value}{network}( x, attrname, unlist = TRUE, na.omit = FALSE, null.na = FALSE, deleted.edges.omit = FALSE, ... ) \method{get.edge.value}{list}( x, attrname, unlist = TRUE, na.omit = FALSE, null.na = FALSE, deleted.edges.omit = FALSE, ... ) get.network.attribute(x, ...) \method{get.network.attribute}{network}(x, attrname, unlist = FALSE, ...) get.vertex.attribute(x, ...) \method{get.vertex.attribute}{network}( x, attrname, na.omit = FALSE, null.na = TRUE, unlist = TRUE, ... ) list.edge.attributes(x, ...) \method{list.edge.attributes}{network}(x, ...) list.network.attributes(x, ...) \method{list.network.attributes}{network}(x, ...) list.vertex.attributes(x, ...) \method{list.vertex.attributes}{network}(x, ...) network.vertex.names(x) network.vertex.names(x) <- value set.edge.attribute(x, attrname, value, e, ...) \method{set.edge.attribute}{network}(x, attrname, value, e = seq_along(x$mel), ...) set.edge.value(x, attrname, value, e, ...) \method{set.edge.value}{network}(x, attrname, value, e = seq_along(x$mel), ...) set.network.attribute(x, attrname, value, ...) \method{set.network.attribute}{network}(x, attrname, value, ...) set.vertex.attribute(x, attrname, value, v = seq_len(network.size(x)), ...) \method{set.vertex.attribute}{network}(x, attrname, value, v = seq_len(network.size(x)), ...) } \arguments{ \item{x}{an object of class \code{network}, or a list of edges (possibly \code{network$mel}) in \code{get.edge.attribute}.} \item{attrname}{the name of the attribute to get or set.} \item{...}{additional arguments} \item{el}{Deprecated; use \code{x} instead.} \item{unlist}{logical; should retrieved attribute values be \code{\link{unlist}}ed prior to being returned?} \item{na.omit}{logical; should retrieved attribute values corresponding to vertices/edges marked as 'missing' be removed?} \item{null.na}{logical; should \code{NULL} values (corresponding to vertices or edges with no values set for the attribute) be replaced with \code{NA}s in output?} \item{deleted.edges.omit}{logical: should the elements corresponding to deleted edges be removed?} \item{value}{values of the attribute to be set; these should be in \code{vector} or \code{list} form for the \code{edge} and \code{vertex} cases, or \code{matrix} form for \code{set.edge.value}.} \item{e}{IDs for the edges whose attributes are to be altered.} \item{v}{IDs for the vertices whose attributes are to be altered.} } \value{ For the \code{list.attributes} methods, a vector containing attribute names. For the \code{get.attribute} methods, a list containing the values of the attribute in question (or simply the value itself, for \code{get.network.attribute}). For the \code{set.attribute} and \code{delete.attribute} methods, a pointer to the updated \code{network} object. } \description{ These methods get, set, list, and delete attributes at the network, edge, and vertex level. } \details{ The \code{list.attributes} functions return the names of all edge, network, or vertex attributes (respectively) in the network. All attributes need not be defined for all elements; the union of all extant attributes for the respective element type is returned. The \code{get.attribute} functions look for an edge, network, or vertex attribute (respectively) with the name \code{attrname}, returning its values. Note that, to retrieve an edge attribute from all edges within a network \code{x}, \code{x$mel} should be used as the first argument to \code{get.edge.attribute}; \code{get.edge.value} is a convenience function which does this automatically. As of v1.7.2, if a \code{network} object is passed to \code{get.edge.attribute} it will automatically call \code{get.edge.value} instead of returning NULL. When the parameters \code{na.omit}, or \code{deleted.edges.omit} are used, the position index of the attribute values returned will not correspond to the vertex/edge id. To preserved backward compatibility, if the edge attribute \code{attrname} does not exist for any edge, \code{get.edge.attribute} will still return \code{NULL} even if \code{null.na=TRUE} \code{network.vertex.names} is a convenience function to extract the \code{"vertex.names"} attribute from all vertices. The \code{set.attribute} functions allow one to set the values of edge, network, or vertex attributes. \code{set.edge.value} is a convenience function which allows edge attributes to be given in adjacency matrix form, and the assignment form of \code{network.vertex.names} is likewise a convenient front-end to \code{set.vertex.attribute} for vertex names. The \code{delete.attribute} functions, by contrast, remove the named attribute from the network, from all edges, or from all vertices (as appropriate). If \code{attrname} is a vector of attribute names, each will be removed in turn. These functions modify their arguments in place, although a pointer to the modified object is also (invisibly) returned. Additional practical example of how to load and attach attributes are on the \code{\link{loading.attributes}} page. Some attribute assignment/extraction can be performed conveniently through the various extraction/replacement operators, although they may be less efficient. See the associated man page for details. } \note{ As of version 1.9 the \code{set.vertex.attribute} function can accept and modify multiple attributes in a single call to improve efficiency. For this case \code{attrname} can be a list or vector of attribute names and \code{value} is a list of values corresponding to the elements of \code{attrname} (can also be a list of lists of values if elements in v should have different values). } \examples{ #Create a network with three edges m<-matrix(0,3,3) m[1,2]<-1; m[2,3]<-1; m[3,1]<-1 g<-network(m) #Create a matrix of values corresponding to edges mm<-m mm[1,2]<-7; mm[2,3]<-4; mm[3,1]<-2 #Assign some attributes set.edge.attribute(g,"myeval",3:5) set.edge.value(g,"myeval2",mm) set.network.attribute(g,"mygval","boo") set.vertex.attribute(g,"myvval",letters[1:3]) network.vertex.names(g) <- LETTERS[1:10] #List the attributes list.edge.attributes(g) list.network.attributes(g) list.vertex.attributes(g) #Retrieve the attributes get.edge.attribute(g$mel,"myeval") #Note the first argument! get.edge.value(g,"myeval") #Another way to do this get.edge.attribute(g$mel,"myeval2") get.network.attribute(g,"mygval") get.vertex.attribute(g,"myvval") network.vertex.names(g) #Purge the attributes delete.edge.attribute(g,"myeval") delete.edge.attribute(g,"myeval2") delete.network.attribute(g,"mygval") delete.vertex.attribute(g,"myvval") #Verify that the attributes are gone list.edge.attributes(g) list.network.attributes(g) list.vertex.attributes(g) #Note that we can do similar things using operators g \%n\% "mygval" <- "boo" #Set attributes, as above g \%v\% "myvval" <- letters[1:3] g \%e\% "myeval" <- mm g[,,names.eval="myeval"] <- mm #Another way to do this g \%n\% "mygval" #Retrieve the attributes g \%v\% "myvval" g \%e\% "mevval" as.sociomatrix(g,"myeval") # Or like this } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{loading.attributes}},\code{\link{network}}, \code{\link{as.network.matrix}}, \code{\link{as.sociomatrix}}, \code{\link{as.matrix.network}}, \code{\link{network.extraction}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{classes} \keyword{graphs} network/man/network.naedgecount.Rd0000644000176200001440000000606514057075374017014 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{missing.edges} \alias{missing.edges} \alias{is.na.network} \alias{network.naedgecount} \title{Identifying and Counting Missing Edges in a Network Object} \usage{ \method{is.na}{network}(x) network.naedgecount(x, ...) } \arguments{ \item{x}{an object of class \code{network}} \item{\dots}{additional arguments, not used} } \value{ \code{is.na(x)} returns a network object, and \code{network.naedgecount(x)} returns the number of missing edges. } \description{ \code{network.naedgecount} returns the number of edges within a \code{network} object which are flagged as missing. The \code{is.na} network method returns a new network containing the missing edges. } \details{ The missingness of an edge is controlled by its \code{na} attribute (which is mandatory for all edges); \code{network.naedgecount} returns the number of edges for which \code{na==TRUE}. The \code{is.na} network method produces a new network object whose edges correspond to the missing (\code{na==TRUE}) edges of the original object, and is thus a covenient method of extracting detailed missingness information on the entire network. The network returned by \code{is.na} is guaranteed to have the same base network attributes (directedness, loopness, hypergraphicity, multiplexity, and bipartite constraint) as the original network object, but no other information is copied; note too that edge IDs are \emph{not} preserved by this process (although adjacency obviously is). Since the resulting object is a \code{\link{network}}, standard coercion, print/summary, and other methods can be applied to it in the usual fashion. It should be borne in mind that \dQuote{missingness} in the sense used here reflects the assertion that an edge's presence or absence is unknown, \emph{not} that said edge is known not to be present. Thus, the \code{na} count for an empty graph is properly 0, since all edges are known to be absent. Edges can be flagged as missing by setting their \code{na} attribute to \code{TRUE} using \code{\link{set.edge.attribute}}, or by appropriate use of the network assignment operators; see below for an example of the latter. } \examples{ #Create an empty network with no missing data g<-network.initialize(5) g[,] #No edges present.... network.naedgecount(g)==0 #Edges not present are not "missing"! #Now, add some missing edges g[1,,add.edges=TRUE]<-NA #Establish that 1's ties are unknown g[,] #Observe the missing elements is.na(g) #Observe in network form network.naedgecount(g)==4 #These elements do count! network.edgecount(is.na(g)) #Same as above } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{network.edgecount}}, \code{\link{get.network.attribute}}, \code{is.adjacent}, \code{\link{is.na}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{classes} \keyword{graphs} network/man/network.dyadcount.Rd0000644000176200001440000000363114057075374016506 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{network.dyadcount} \alias{network.dyadcount} \alias{network.dyadcount.network} \title{Return the Number of (Possibly Directed) Dyads in a Network Object} \usage{ \method{network.dyadcount}{network}(x, na.omit = TRUE, ...) } \arguments{ \item{x}{an object of class \code{network}} \item{na.omit}{logical; omit edges with \code{na==TRUE} from the count?} \item{\dots}{possible additional arguments, used by other implementations} } \value{ The number of dyads in the network } \description{ \code{network.dyadcount} returns the number of possible dyads within a \code{network}, removing those flagged as missing if desired. If the network is directed, directed dyads are counted accordingly. } \details{ The return value \code{network.dyadcount} is equal to the number of dyads, minus the number of \code{NULL} edges (and missing edges, if \code{na.omit==TRUE}). If \code{x} is directed, the number of directed dyads is returned. If the network allows loops, the number of possible entries on the diagnonal is added. Allthough the function does not give an error on multiplex networks or hypergraphs, the results probably don't make sense. } \examples{ #Create a directed network with three edges m<-matrix(0,3,3) m[1,2]<-1; m[2,3]<-1; m[3,1]<-1 g<-network(m) network.dyadcount(g)==6 #Verify the directed dyad count g<-network(m|t(m),directed=FALSE) network.dyadcount(g)==3 #nC2 in undirected case } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \url{https://www.jstatsoft.org/v24/i02/} } \seealso{ \code{\link{get.network.attribute}}, \code{\link{network.edgecount}}, \code{\link{is.directed}} } \author{ Mark S. Handcock \email{handcock@stat.washington.edu}, skyebend } \keyword{classes} \keyword{graphs} network/DESCRIPTION0000644000176200001440000000376414061574701013470 0ustar liggesusersPackage: network Version: 1.17.1 Date: 2021-06-12 Title: Classes for Relational Data Authors@R: c( person("Carter T.", "Butts", role=c("aut","cre"), email="buttsc@uci.edu"), person("David", "Hunter", role=c("ctb"), email="dhunter@stat.psu.edu"), person("Mark", "Handcock", role=c("ctb"), email="handcock@stat.ucla.edu"), person("Skye", "Bender-deMoll", role=c("ctb"), email="skyebend@uw.edu"), person("Jeffrey", "Horner", role=c("ctb"), email="jeffrey.horner@gmail.com"), person("Li", "Wang", role=c("ctb"), email="lxwang@uw.edu"), person("Pavel N.", "Krivitsky", role=c("ctb"), email="pavel@statnet.org", comment=c(ORCID="0000-0002-9101-3362")), person("Brendan", "Knapp", role=c("ctb"), email="brendan.g.knapp@gmail.com", comment=c(ORCID="0000-0003-3284-4972")), person("Michał", "Bojanowski", role=c("ctb"), email="mbojanowski@kozminski.edu.pl"), person("Chad", "Klumb", role=c("ctb"), email="cklumb@gmail.com")) Author: Carter T. Butts [aut, cre], David Hunter [ctb], Mark Handcock [ctb], Skye Bender-deMoll [ctb], Jeffrey Horner [ctb], Li Wang [ctb], Pavel N. Krivitsky [ctb] (), Brendan Knapp [ctb] (), Michał Bojanowski [ctb], Chad Klumb [ctb] Maintainer: Carter T. Butts Depends: R (>= 2.10), utils Imports: tibble, magrittr, statnet.common (>= 4.5), stats Suggests: sna, testthat, covr Description: Tools to create and modify network objects. The network class can represent a range of relational data types, and supports arbitrary vertex/edge/graph attributes. License: GPL (>= 2) URL: http://statnet.org/ RoxygenNote: 7.1.1 Collate: 'access.R' 'as.edgelist.R' 'assignment.R' 'coercion.R' 'constructors.R' 'dataframe.R' 'fileio.R' 'layout.R' 'misc.R' 'network-package.R' 'operators.R' 'plot.R' 'printsum.R' 'zzz.R' Encoding: UTF-8 NeedsCompilation: yes Packaged: 2021-06-14 01:46:28 UTC; buttsc Repository: CRAN Date/Publication: 2021-06-14 06:40:01 UTC network/build/0000755000176200001440000000000014061532363013045 5ustar liggesusersnetwork/build/vignette.rds0000644000176200001440000000031114061532363015377 0ustar liggesusersb```b`a`e`b2 1#PH 祖eeY%zAyhJJ`jQD˄ Ik^bnj1).y) 3GZ E T [fN*ސ89 d Bw(,/׃ @?{49'ݣ\)%ziE@ w[Fnetwork/tests/0000755000176200001440000000000013737227152013116 5ustar liggesusersnetwork/tests/pathological.tests.R0000644000176200001440000000123113357022000017024 0ustar liggesuserslibrary(network) if (require(statnet.common,quietly=TRUE)){ opttest({ gctorture(TRUE) n <- 10 test <- network.initialize(n) for (i in 1:(n-1)){ for (j in (i+1):n){ cat(i,j,'\n') get.inducedSubgraph(test,v=i:j) } } gctorture(FALSE) },'Ticket #180 Test 1','NETWORK_pathology_TESTS') opttest({ gctorture(TRUE) test <- network.initialize(10) delete.vertices(test,5) gctorture(FALSE) },'Ticket #180 Test 2','NETWORK_pathology_TESTS') opttest({ x <- network.initialize(10) x[,] <- 1 try(set.edge.value(x,'foo',matrix('bar',5,5))) },'Ticket #827','NETWORK_pathology_TESTS') } network/tests/network.access.test.R0000644000176200001440000000546613357022000017142 0ustar liggesuserslibrary(network) binet = network.initialize(10, bipartite = 6) set.vertex.attribute(binet, 'myval', paste('b1', 1:6), v=1:6) set.vertex.attribute(binet, 'myval', paste('b2', 1:4), v=7:10) check <- vector() check[1] <- all(get.vertex.attribute(binet, 'myval') == c("b1 1", "b1 2", "b1 3", "b1 4", "b1 5", "b1 6", "b2 1", "b2 2", "b2 3" ,"b2 4")) # check for distinction between bipartite=FALSE and bipartite=0 testA<-network.initialize(3,bipartite=0) if(!is.bipartite(testA)){ stop('failed test of is.bipartite for bipartite=0') } testB<-network.initialize(3,bipartite=FALSE) if(is.bipartite(testB)){ stop('failed test of is.bipartite for bipartite=FALSE') } testC<-network.initialize(3,bipartite=TRUE) if(!is.bipartite(testC)){ stop('failed test of is.bipartite for bipartite=TRUE') } if(!is.bipartite(binet)){ stop('failed test of is.bipartite for bipartite=6') } # add vertices to bipartite graphs g = binet; add.vertices(g, 5, last.mode=F) check[2] <- network.size(g) == 15 check[3] <- get.network.attribute(g, 'bipartite') == 11 check[4] <- identical(get.vertex.attribute(g, 'myval'), c("b1 1", "b1 2", "b1 3", "b1 4", "b1 5", "b1 6", NA,NA,NA,NA,NA,"b2 1","b2 2","b2 3","b2 4")) test<-network.initialize(3,bipartite=0) test%v%'letters'<-LETTERS[1:3] add.vertices(test,nv=1,last.mode=FALSE) if(!identical(test%v%'letters',c(NA,"A","B","C"))){ stop("Error adding vertices to first mode of network with biparite=0") } test<-network.initialize(3,bipartite=0) test%v%'letters'<-LETTERS[1:3] add.vertices(test,nv=1,last.mode=TRUE) if(!identical(test%v%'letters',c("A","B","C",NA))){ stop("Error adding vertices to last mode of network with biparite=0") } g = binet add.vertices(g, 5, last.mode=T) check[5] <- network.size(g) == 15 check[6] <- get.network.attribute(g, 'bipartite') == 6 check[7] <- identical(get.vertex.attribute(g, 'myval'), c("b1 1", "b1 2", "b1 3", "b1 4", "b1 5", "b1 6","b2 1","b2 2","b2 3","b2 4", NA,NA,NA,NA,NA)) # replacement operators should always replace y <- network.initialize(4,dir=FALSE) # This network can have at most 1 edge. y[1,2] <- NA # Assign NA to (1,2) y[1,2] <- NA check[8] <- network.edgecount(y) == 0 check[9] <- network.edgecount(y, na.omit=F) == 1 y[,] <- 1 check[10] <- network.edgecount(y) == 6 y[,] <- NA check[11] <- network.edgecount(y) == 0 check[12] <- network.edgecount(y, na.omit=F) == 6 y[,] <- 0 check[13] <- network.edgecount(y, na.omit=F) == 0 # ------ test valid.eids function net<-network.initialize(4) net[,]<-1 delete.edges(net,eid=4:6) if(!all(valid.eids(net)==c(1,2,3,7,8,9,10,11,12))){ stop('valid.eids did not return correct ids for non-null elements of network') } #If everything worked, check is TRUE if(!all(check)){ #Should be TRUE stop(paste("network package test failed on test(s):",which(!check))) }network/tests/benchmarks0000644000176200001440000000041213357022000015132 0ustar liggesusers"elapsed" "init" 0.947000000000116 "setv" 0.266000000000076 "getv" 0.346000000000004 "listv" 0.130999999999858 "adde" 1.29500000000007 "sete" 3.89800000000014 "gete" 0.196000000000367 "liste" 0.240999999999985 "addmoree" 2.10499999999956 "addmorev" 1.60500000000002 network/tests/list.attribute.tests.R0000644000176200001440000000401713357022000017340 0ustar liggesusersrequire(network) # --------- test list.vertex.attributes --- net<-network.initialize(3) list.vertex.attributes(net) if(!all(list.vertex.attributes(net)==c('na','vertex.names'))){ stop('list.vertex.attribute did not report default attributes corrrectly') } set.vertex.attribute(net,'letters',c("a","b","c")) if(!all(list.vertex.attributes(net)==c('letters','na','vertex.names'))){ stop('list.vertex.attribute did not report added attributes corrrectly') } # ----- test list.edge.attributes ---- net<-network.initialize(3) if(length(list.edge.attributes(net))!=0){ stop("list.edge.attributes did not return empty list for network with no edges") } add.edges(net,1,2) add.edges(net,2,3) if(list.edge.attributes(net)!='na'){ stop("list.edge.attributes did not return 'na' for network with only edges") } set.edge.attribute(net,'letter',c("a","b")) if(!all(list.edge.attributes(net)==c('letter','na'))){ stop("list.edge.attributes did not return attribute names for network with edges") } delete.edges(net,eid=1) if(!all(list.edge.attributes(net)==c('letter','na'))){ stop("list.edge.attributes did not return attribute names for network deleted edge") } # ---- test list.network.attributes ---- net<-network.initialize(3) if(!all(list.network.attributes(net)==c("bipartite", "directed", "hyper","loops","mnext", "multiple","n" ))){ stop("list.network.attributes returned unexpected values for default attributes of a network") } set.network.attribute(net,'letter',"a") if(!all(list.network.attributes(net)==c("bipartite", "directed", "hyper","letter","loops","mnext", "multiple","n" ))){ stop("list.network.attributes returned unexpected values for network with attribute added") } # ----- tests for printing function for edges cases ------ net<-network.initialize(100) net%n%'a_matrix'<-matrix(1:100,nrow=10,ncol=10) net%n%'a_null'<-NULL net%n%'a_list'<-list(part1=list(c("A","B")),part2=list("c")) net%n%'a_desc_vec'<-numeric(rep(100,1)) net%n%'a_net'<-network.initialize(5) print.network(net) network/tests/testthat/0000755000176200001440000000000014061574701014752 5ustar liggesusersnetwork/tests/testthat/test-misc_tests.R0000644000176200001440000000050113740520334020217 0ustar liggesusers# tests for misc R functions test<-network.initialize(5) test[1,2]<-1 expect_equal(has.edges(test), c(TRUE,TRUE,FALSE,FALSE,FALSE)) expect_equal(has.edges(test,v=2:3),c(TRUE,FALSE)) expect_error(has.edges(test,v=10),regexp = 'argument must be a valid vertex id') expect_equal(length(has.edges(network.initialize(0))),0) network/tests/testthat/test-dataframe.R0000644000176200001440000006657513740520334020015 0ustar liggesuserstest_that("invalid or conflicting arguments throw", { edge_df <- data.frame(from = 1:3, to = 4:6) expect_error( as.network(edge_df, directed = "should be true or false"), "The following arguments must be either `TRUE` or `FALSE`:\n\t- directed", fixed = TRUE ) expect_error( as.network(edge_df, hyper = NULL), "The following arguments must be either `TRUE` or `FALSE`:\n\t- hyper", fixed = TRUE ) expect_error( as.network(edge_df, loops = NA), "The following arguments must be either `TRUE` or `FALSE`:\n\t- loops", fixed = TRUE ) expect_error( as.network(edge_df, bipartite = 1), "The following arguments must be either `TRUE` or `FALSE`:\n\t- bipartite", fixed = TRUE ) hyper_edge_df <- data.frame(from = c("a,b", "b,c"), to = c("c,d", "e,f"), stringsAsFactors = FALSE) hyper_edge_df[] <- lapply(hyper_edge_df, strsplit, split = ",") expect_warning( as.network(hyper_edge_df, hyper = TRUE, directed = FALSE), "If `hyper` is `TRUE` and `directed` is `FALSE`, `loops` must be `TRUE`.", fixed = TRUE ) expect_error( suppressWarnings( as.network(hyper_edge_df, hyper = TRUE, bipartite = TRUE, loops = TRUE, directed = FALSE) ), "Both `hyper` and `bipartite` are `TRUE`, but bipartite hypergraphs are not supported.", fixed = TRUE ) }) test_that("simple networks are built correctly", { simple_edge_df <- data.frame(.tail = c("b", "c", "c", "d", "d", "e"), .head = c("a", "b", "a", "a", "b", "a"), time = 1:6, stringsAsFactors = FALSE) simple_vertex_df <- data.frame(vertex.names = letters[1:5], type = letters[1:5], stringsAsFactors = FALSE) expect_s3_class( as.network(x = simple_edge_df), "network" ) expect_s3_class( as.network(x = simple_edge_df, vertices = simple_vertex_df), "network" ) expect_true( is.directed(as.network(x = simple_edge_df)) ) expect_false( is.directed(as.network(x = simple_edge_df, directed = FALSE)) ) expect_false( has.loops(as.network(x = simple_edge_df)) ) expect_false( is.multiplex(as.network(x = simple_edge_df)) ) expect_equal( network.edgecount(as.network(x = simple_edge_df)), nrow(simple_edge_df) ) expect_equal( network.size(as.network(x = simple_edge_df)), nrow(simple_vertex_df) ) simple_g <- as.network(x = simple_edge_df, vertices = simple_vertex_df) delete.edges(simple_g, 2) expect_identical( `rownames<-`(simple_edge_df[-2, ], NULL), as.data.frame(simple_g) ) delete.vertices(simple_g, 2) expect_identical( `rownames<-`(simple_vertex_df[-2, , drop = FALSE], NULL), as.data.frame(simple_g, unit = "vertices") ) }) test_that("simple and complex edge/vertex/R-object attributes are safely handled", { vertex_df <- data.frame(name = letters[5:1], lgl_attr = c(TRUE, FALSE, TRUE, FALSE, TRUE), int_attr = as.integer(seq_len(5)), dbl_attr = as.double(seq_len(5)), chr_attr = LETTERS[1:5], date_attr = seq.Date(as.Date("2019-12-22"), as.Date("2019-12-26"), by = 1), dttm_attr = as.POSIXct( seq.Date(as.Date("2019-12-22"), as.Date("2019-12-26"), by = 1) ), stringsAsFactors = FALSE) attr(vertex_df$date_attr, "tzone") <- "PST" attr(vertex_df$dttm_attr, "tzone") <- "EST" vertex_df$list_attr <- replicate(5, LETTERS, simplify = FALSE) vertex_df$mat_list_attr <- replicate(5, as.matrix(mtcars), simplify = FALSE) vertex_df$df_list_attr <- replicate(5, mtcars, simplify = FALSE) vertex_df$sfg_attr <- list( structure(c(1, 2, 3), class = c("XY", "POINT", "sfg")), structure(1:10, .Dim = c(5L, 2L), class = c("XY", "MULTIPOINT", "sfg")), structure(1:10, .Dim = c(5L, 2L), class = c("XY", "LINESTRING", "sfg")), structure(list(structure(c(0, 10, 10, 0, 0, 0, 0, 10, 10, 0), .Dim = c(5L, 2L)), structure(c(1, 1, 2, 2, 1, 1, 2, 2, 1, 1), .Dim = c(5L, 2L)), structure(c(5, 5, 6, 6, 5, 5, 6, 6, 5, 5), .Dim = c(5L, 2L))), class = c("XY", "MULTILINESTRING", "sfg")), structure(list(structure(c(0, 10, 10, 0, 0, 0, 0, 10, 10, 0),.Dim = c(5L, 2L)), structure(c(1, 1, 2, 2, 1, 1, 2, 2, 1, 1), .Dim = c(5L, 2L)), structure(c(5, 5, 6, 6, 5, 5, 6, 6, 5, 5), .Dim = c(5L, 2L))), class = c("XY", "POLYGON", "sfg")) ) edge_df <- data.frame(from = c("b", "c", "c", "d", "d", "e"), to = c("a", "b", "a", "a", "b", "a"), lgl_attr = c(TRUE, FALSE, TRUE, FALSE, TRUE, FALSE), int_attr = as.integer(seq_len(6)), dbl_attr = as.double(seq_len(6)), chr_attr = LETTERS[1:6], date_attr = seq.Date(as.Date("2019-12-22"), as.Date("2019-12-27"), by = 1), dttm_attr = as.POSIXct( seq.Date(as.Date("2019-12-22"), as.Date("2019-12-27"), by = 1) ), stringsAsFactors = FALSE) attr(edge_df$date_attr, "tzone") <- "PST" attr(edge_df$dttm_attr, "tzone") <- "EST" edge_df$list_attr <- replicate(6, LETTERS, simplify = FALSE) edge_df$mat_list_attr <- replicate(6, as.matrix(mtcars), simplify = FALSE) edge_df$df_list_attr <- replicate(6, mtcars, simplify = FALSE) edge_df$sfg_attr <- list( structure(c(1, 2, 3), class = c("XY", "POINT", "sfg")), structure(1:10, .Dim = c(5L, 2L), class = c("XY", "MULTIPOINT", "sfg")), structure(1:10, .Dim = c(5L, 2L), class = c("XY", "LINESTRING", "sfg")), structure(list(structure(c(0, 10, 10, 0, 0, 0, 0, 10, 10, 0), .Dim = c(5L, 2L)), structure(c(1, 1, 2, 2, 1, 1, 2, 2, 1, 1), .Dim = c(5L, 2L)), structure(c(5, 5, 6, 6, 5, 5, 6, 6, 5, 5), .Dim = c(5L, 2L))), class = c("XY", "MULTILINESTRING", "sfg")), structure(list(structure(c(0, 10, 10, 0, 0, 0, 0, 10, 10, 0),.Dim = c(5L, 2L)), structure(c(1, 1, 2, 2, 1, 1, 2, 2, 1, 1), .Dim = c(5L, 2L)), structure(c(5, 5, 6, 6, 5, 5, 6, 6, 5, 5), .Dim = c(5L, 2L))), class = c("XY", "POLYGON", "sfg")), structure(list(list(structure(c(0, 10, 10, 0, 0, 0, 0, 10, 10, 0), .Dim = c(5L, 2L)), structure(c(1, 1, 2, 2, 1, 1, 2, 2, 1, 1), .Dim = c(5L, 2L)), structure(c(5, 5, 6, 6, 5, 5, 6, 6, 5, 5), .Dim = c(5L, 2L))), list(structure(c(12, 22, 22, 12, 12, 12, 12, 22, 22, 12), .Dim = c(5L, 2L)), structure(c(13, 13, 14, 14, 13, 13, 14, 14, 13, 13), .Dim = c(5L, 2L))), list(structure(c(24, 34, 34, 24, 24, 24, 24, 34, 34, 24), .Dim = c(5L, 2L)))), class = c("XY", "MULTIPOLYGON", "sfg")) ) g_many_attrs <- as.network(edge_df, vertices = vertex_df) # edge attributes ====================================================================== # bare atomic vectors expect_identical( get.edge.attribute(g_many_attrs, "lgl_attr"), edge_df$lgl_attr ) expect_identical( get.edge.attribute(g_many_attrs, "int_attr"), edge_df$int_attr ) expect_identical( get.edge.attribute(g_many_attrs, "dbl_attr"), edge_df$dbl_attr ) expect_identical( get.edge.attribute(g_many_attrs, "chr_attr"), edge_df$chr_attr ) # atomic vectors w/ attributes # TODO is there a way to get atomic vectors back while preserving attributes? # `c()` `v/sapply()` strip attributes edge_date_attr <- get.edge.attribute(g_many_attrs, "date_attr", unlist = FALSE) edge_date_attr_to_test <- `attributes<-`(unlist(edge_date_attr), attributes(edge_date_attr[[1]])) expect_identical( edge_date_attr_to_test, edge_df$date_attr ) edge_dttm_attr <- get.edge.attribute(g_many_attrs, "dttm_attr", unlist = FALSE) edge_dttm_attr_to_test <- `attributes<-`(unlist(edge_dttm_attr), attributes(edge_dttm_attr[[1]])) expect_identical( edge_dttm_attr_to_test, edge_df$dttm_attr ) # list of bare atomic vectors expect_identical( get.edge.attribute(g_many_attrs, "list_attr", unlist = FALSE), edge_df$list_attr ) # list of vectors with attributes expect_identical( get.edge.attribute(g_many_attrs, "mat_list_attr", unlist = FALSE), edge_df$mat_list_attr ) # recursive lists expect_identical( get.edge.attribute(g_many_attrs, "df_list_attr", unlist = FALSE), edge_df$df_list_attr ) # sf objects expect_identical( get.edge.attribute(g_many_attrs, "sfg_attr", unlist = FALSE), edge_df$sfg_attr ) # vertex attributes ==================================================================== # bare atomic vectors expect_identical( get.vertex.attribute(g_many_attrs, "vertex.names"), vertex_df[[1]] ) expect_identical( get.vertex.attribute(g_many_attrs, "lgl_attr"), vertex_df$lgl_attr ) expect_identical( get.vertex.attribute(g_many_attrs, "int_attr"), vertex_df$int_attr ) expect_identical( get.vertex.attribute(g_many_attrs, "dbl_attr"), vertex_df$dbl_attr ) expect_identical( get.vertex.attribute(g_many_attrs, "chr_attr"), vertex_df$chr_attr ) # atomic vectors w/ attributes # TODO is there a way to get atomic vectors back while preserving attributes? # `c()` `v/sapply()` strip attributes vertex_date_attr <- get.vertex.attribute(g_many_attrs, "date_attr", unlist = FALSE) vertex_date_attr_to_test <- `attributes<-`(unlist(vertex_date_attr), attributes(vertex_date_attr[[1]])) expect_identical( vertex_date_attr_to_test, vertex_df$date_attr ) vertex_dttm_attr <- get.vertex.attribute(g_many_attrs, "dttm_attr", unlist = FALSE) vertex_dttm_attr_to_test <- `attributes<-`(unlist(vertex_dttm_attr), attributes(vertex_dttm_attr[[1]])) expect_identical( vertex_dttm_attr_to_test, vertex_df$dttm_attr ) # list of bare atomic vectors expect_identical( get.vertex.attribute(g_many_attrs, "list_attr", unlist = FALSE), vertex_df$list_attr ) # list of vectors with attributes expect_identical( get.vertex.attribute(g_many_attrs, "mat_list_attr", unlist = FALSE), vertex_df$mat_list_attr ) # recursive lists expect_identical( get.vertex.attribute(g_many_attrs, "df_list_attr", unlist = FALSE), vertex_df$df_list_attr ) # sf objects expect_identical( get.vertex.attribute(g_many_attrs, "sfg_attr", unlist = FALSE), vertex_df$sfg_attr ) # conversion back to data.frame ======================================================== names(edge_df)[[1]] <- ".tail" names(edge_df)[[2]] <- ".head" edge_df$sfc_attr <- NULL names(vertex_df)[[1]] <- "vertex.names" vertex_df$sfc_attr <- NULL g_many_attrs <- delete.vertex.attribute(g_many_attrs, "sfc_attr") g_many_attrs <- delete.edge.attribute(g_many_attrs, "sfc_attr") expect_identical( edge_df, as.data.frame(g_many_attrs) ) expect_identical( vertex_df, as.data.frame(g_many_attrs, unit = "vertices") ) }) test_that("`multiple` arguments work", { dir_parallel_edge_df <- data.frame(from = c("a", "a"), to = c("b", "b"), stringsAsFactors = FALSE) expect_error( as.network(dir_parallel_edge_df), "`multiple` is `FALSE`, but `x` contains parallel edges." ) expect_s3_class( as.network(dir_parallel_edge_df, multiple = TRUE), "network" ) expect_true( is.multiplex(as.network(dir_parallel_edge_df, multiple = TRUE)) ) expect_true( is.directed(as.network(dir_parallel_edge_df, multiple = TRUE)) ) undir_parallel_edge_df <- data.frame(from = c("a", "b"), to = c("b", "a"), stringsAsFactors = FALSE) expect_s3_class( as.network(undir_parallel_edge_df), "network" ) expect_error( as.network(undir_parallel_edge_df, directed = FALSE), "`multiple` is `FALSE`, but `x` contains parallel edges." ) expect_s3_class( as.network(undir_parallel_edge_df, directed = FALSE, multiple = TRUE), "network" ) expect_true( is.multiplex(as.network(undir_parallel_edge_df, directed = FALSE, multiple = TRUE)) ) expect_false( is.directed(as.network(undir_parallel_edge_df, directed = FALSE, multiple = TRUE)) ) }) test_that("`loops` works", { df_with_loops <- data.frame(from = c("b", "c", "c", "d", "d", "e", "f"), to = c("a", "b", "a", "a", "b", "a", "f"), stringsAsFactors = FALSE) expect_error( as.network(df_with_loops), "`loops` is `FALSE`" ) expect_s3_class( as.network(df_with_loops, loops = TRUE), "network" ) }) test_that("missing vertex names are caught", { missing_vertex_df <- data.frame(name = letters[1:5], stringsAsFactors = FALSE) missing_edge_df <- data.frame(from = c("b", "c", "c", "d", "d", "e", "f"), to = c("a", "b", "a", "a", "b", "a", "g"), stringsAsFactors = FALSE) expect_error( as.network(missing_edge_df, vertices = missing_vertex_df), "The following vertices are in `x`, but not in `vertices`:\n\t- f\n\t- g", fixed = TRUE ) }) test_that("duplicate vertex names are caught", { dup_vertex_df <- data.frame(name = c("a", "a", "b", "c", "d", "e"), stringsAsFactors = FALSE) dup_edge_df <- data.frame(from = c("b", "c", "c", "d", "d", "e"), to = c("a", "b", "a", "a", "b", "a"), stringsAsFactors = FALSE) expect_error( as.network(dup_edge_df, vertices = dup_vertex_df), "The following vertex names are duplicated in `vertices`:\n\t- a", fixed = TRUE ) }) test_that("bad data frames are caught", { edge_df_with_NAs1 <- data.frame(from = c(letters, NA), to = c("a", letters), stringsAsFactors = FALSE) edge_df_with_NAs2 <- data.frame(from = c(letters, "a"), to = c(NA, letters), stringsAsFactors = FALSE) empty_vertex_df <- data.frame() expect_error( as.network(edge_df_with_NAs2), "The first two columns of `x` cannot contain `NA` values.", fixed = TRUE ) expect_error( as.network(edge_df_with_NAs2), "The first two columns of `x` cannot contain `NA` values.", fixed = TRUE ) expect_error( as.network(edge_df_with_NAs1[0, 0]), "`x` should be a data frame with at least two columns and one row.", fixed = TRUE ) expect_error( as.network(na.omit(edge_df_with_NAs1), vertices = empty_vertex_df, loops = TRUE), "`vertices` should contain at least one column and row.", fixed = TRUE ) incompat_edge_types <- data.frame( from = c("a", "b"), to = c(1, 2), stringsAsFactors = FALSE ) expect_error( as.network(incompat_edge_types), "The first two columns of `x` must be of the same type.", fixed = TRUE ) non_df_vertices_edge_df <- data.frame(from = 1, to = 2) non_df_vertices <- list(name = 1:2) expect_error( as.network(non_df_vertices_edge_df, vertices = non_df_vertices), "If provided, `vertices` should be a data frame.", fixed = TRUE ) bad_vertex_names_col <- data.frame(name = I(list(1))) expect_error( as.network(non_df_vertices_edge_df, vertices = bad_vertex_names_col), "The first column of `vertices` must be an atomic vector.", fixed = TRUE ) incompat_types_edge_df <- data.frame(from = 1:3, to = 4:6) incompat_types_vertex_df <- data.frame(name = paste(1:6), stringsAsFactors = FALSE) expect_error( as.network(incompat_types_edge_df, vertices = incompat_types_vertex_df), "The first column of `vertices` must be the same type as the value with which they are referenced in `x`'s first two columns.", fixed = TRUE ) recursive_edge_df <- data.frame(from = I(list(1:2)), to = 3) expect_error( as.network(recursive_edge_df), "If `hyper` is `FALSE`, the first two columns of `x` should be atomic vectors.", fixed = TRUE ) }) test_that("bipartite networks work", { bip_edge_df <- data.frame(.tail = c("a", "a", "b", "b", "c", "d", "d", "e"), .head = c("e1", "e2", "e1", "e3", "e3", "e2", "e3", "e1"), an_edge_attr = letters[1:8], stringsAsFactors = FALSE) bip_node_df <- data.frame(vertex.names = c("a", "e1", "b", "e2", "c", "e3", "d", "e"), node_type = c("person", "event", "person", "event", "person", "event", "person", "person"), color = c("red", "blue", "red", "blue", "red", "blue", "red", "red"), stringsAsFactors = FALSE) expect_silent( # vertices already in correct order as.network(bip_edge_df, directed = FALSE, vertices = data.frame(name = unique(unlist(bip_edge_df[1:2])))) ) expect_warning( # warn that vertices are reordered once as.network(bip_edge_df, directed = FALSE, vertices = bip_node_df, bipartite = TRUE) ) expect_silent( # do not warn again in the same session as.network(bip_edge_df, directed = FALSE, vertices = bip_node_df, bipartite = TRUE) ) expect_warning( as.network(bip_edge_df, vertices = bip_node_df, bipartite = TRUE), "If `bipartite` is `TRUE`, edges are interpreted as undirected.", fixed = TRUE ) expect_warning( as.network(bip_edge_df, directed = FALSE, vertices = bip_node_df, bipartite = TRUE, loops = TRUE), "If `bipartite` is `TRUE`, `loops` must be `FALSE`.", fixed = TRUE ) bip_g <- as.network(bip_edge_df, directed = FALSE, vertices = bip_node_df, loops = FALSE, bipartite = TRUE) expect_identical( bip_edge_df, as.data.frame(bip_g) ) expect_identical( # tracking modes by vertex order means we have to reorder the data frame # and reset row.names to test `rownames<-`( bip_node_df[order(bip_node_df$node_type == "person", decreasing = TRUE), ], NULL ), as.data.frame(bip_g, unit = "vertices") ) expect_s3_class( bip_g, "network" ) expect_true( is.bipartite(bip_g) ) expect_false( has.loops(bip_g) ) expect_false( is.directed(bip_g) ) expect_identical( get.network.attribute(bip_g, "bipartite"), 5L ) expect_identical( get.vertex.attribute(bip_g, attrname = "node_type"), c(rep("person", 5), rep("event", 3)) ) expect_identical( get.vertex.attribute(bip_g, attrname = "vertex.names"), c("a", "b", "c", "d", "e", "e1", "e2", "e3") ) expect_identical( get.edge.attribute(bip_g, attrname = "an_edge_attr"), letters[1:8] ) # check if bipartite networks with isolates are caught bip_isolates_node_df <- data.frame( vertex.names = c("a", "e1", "b", "e2", "c", "e3", "d", "e", "f", "g"), stringsAsFactors = FALSE ) expect_error( as.network(x = bip_edge_df, directed = FALSE, vertices = bip_isolates_node_df, bipartite = TRUE), "`bipartite` is `TRUE`, but the `vertices` you provided contain names that are not present in `x`" ) bip_isolates_node_df$is_actor <- !grepl("^e\\d$", bip_isolates_node_df$vertex.names) bip_isoaltes_g <- as.network(x = bip_edge_df, directed = FALSE, vertices = bip_isolates_node_df, bipartite = TRUE) expect_s3_class( bip_isoaltes_g, "network" ) expect_identical( bip_edge_df, as.data.frame(bip_isoaltes_g) ) expect_identical( `rownames<-`( bip_isolates_node_df[order(bip_isolates_node_df$is_actor, decreasing = TRUE), ], NULL ), as.data.frame(bip_isoaltes_g, unit = "vertices") ) # use custom `bipartite_col` name bip_isolates_node_df$my_bipartite_col <- bip_isolates_node_df$is_actor expect_identical( as.network(x = bip_edge_df, directed = FALSE, vertices = bip_isolates_node_df, bipartite = TRUE), as.network(x = bip_edge_df, directed = FALSE, vertices = bip_isolates_node_df, bipartite = TRUE, bipartite_col = "my_bipartite_col") ) # throw errors on invalid `bipartite_col`s expect_error( as.network(x = bip_edge_df, directed = FALSE, vertices = bip_isolates_node_df, bipartite = TRUE, bipartite_col = NA_character_) ) expect_error( as.network(x = bip_edge_df, directed = FALSE, vertices = bip_isolates_node_df, bipartite = TRUE, bipartite_col = list()) ) expect_error( as.network(x = bip_edge_df, directed = FALSE, vertices = bip_isolates_node_df, bipartite = TRUE, bipartite_col = c("bad", "arg")) ) bip_isolates_node_df$is_actor <- as.integer(bip_isolates_node_df$is_actor) expect_error( as.network(x = bip_edge_df, directed = FALSE, vertices = bip_isolates_node_df, bipartite = TRUE), "`bipartite` is `TRUE` and vertex types are specified via a column in `vertices` named `\"is_actor\"`.\n\t- If provided, all values in `vertices[[\"is_actor\"]]` must be `TRUE` or `FALSE`.", fixed = TRUE ) # check if nodes that appear in both of the first 2 `edge` columns are caught bip_confused_edge_df <- data.frame( actor = c("a", "a", "b", "b", "c", "d", "d", "e", "e1"), event = c("e1", "e2", "e1", "e3", "e3", "e2", "e3", "e1", "e2"), stringsAsFactors = FALSE ) expect_error( as.network(x = bip_confused_edge_df, directed = FALSE, bipartite = TRUE), "`bipartite` is `TRUE`, but there are vertices that appear in both of the first two columns of `x`." ) }) test_that("hyper-edges work", { hyper_edge_df <- structure( list(.tail = list(1:4, 3:5, 4:7, 6:10), .head = list(1:4, 3:5, 4:7, 6:10), value = as.double(5:8)), row.names = 1:4, class = "data.frame" ) hyper_target_net <- network.initialize(10, directed = FALSE, hyper = TRUE, loops = TRUE) hyper_target_net <- add.edge(hyper_target_net, 1:4, 1:4, "value", list(5)) hyper_target_net <- add.edge(hyper_target_net, 3:5, 3:5, "value", list(6)) hyper_target_net <- add.edge(hyper_target_net, 4:7, 4:7, "value", list(7)) hyper_target_net <- add.edge(hyper_target_net, 6:10, 6:10, "value", list(8)) expect_identical( as.network(hyper_edge_df, directed = FALSE, hyper = TRUE, loops = TRUE), hyper_target_net ) expect_identical( hyper_edge_df, as.data.frame(hyper_target_net) ) MtSHbyloc_edge_df <- structure( list( .tail = list( as.integer(c(1, 14, 15, 16, 17, 18, 19, 21, 22, 23, 24, 25, 26, 27)), as.integer(c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 20, 26, 27)) ), .head = list( as.integer(c(1, 14, 15, 16, 17, 18, 19, 21, 22, 23, 24, 25, 26, 27)), as.integer(c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 20, 26, 27)) ) ), row.names = 1:2, class = "data.frame" ) MtSHbyloc_vertex_df <- data.frame( vertex.names = 1:27 ) data("emon") MtSHloc <- emon$MtStHelens %v% "Location" MtSHimat <- cbind(MtSHloc %in% c("L", "B"), MtSHloc %in% c("NL", "B")) MtSHbyloc <- network(MtSHimat, matrix = "incidence", hyper = TRUE, directed = FALSE, loops = TRUE) expect_identical( as.network(MtSHbyloc_edge_df, directed = FALSE, vertices = MtSHbyloc_vertex_df, loops = TRUE, hyper = TRUE), MtSHbyloc ) expect_identical( MtSHbyloc_edge_df, as.data.frame(MtSHbyloc) ) expect_identical( MtSHbyloc_vertex_df, as.data.frame(MtSHbyloc, unit = "vertices") ) delete.edges(MtSHbyloc, 2) expect_identical( `rownames<-`(MtSHbyloc_edge_df[-2, ], NULL), as.data.frame(MtSHbyloc) ) delete.vertices(MtSHbyloc, 2) expect_identical( `rownames<-`(MtSHbyloc_vertex_df[-2, , drop = FALSE], NULL), as.data.frame(MtSHbyloc, unit = "vertices") ) hyper_edges_with_NA <- data.frame( from = I(list(c(NA, "a", "b"))), to = I(list(c("c", "d"))) ) expect_error( as.network(hyper_edges_with_NA, hyper = TRUE), "`x`'s first two columns contain invalid values." ) non_hyper_edges <- data.frame( from = 1:3, to = 4:6 ) expect_error( as.network(non_hyper_edges, hyper = TRUE), "If `hyper` is `TRUE`, the first two columns of `x` should be list columns." ) incompat_type_hyper_edges <- data.frame( from = I(list(letters[1:5], 1:5)), to = I(list(letters[6:10], letters[11:15])) ) expect_error( as.network(incompat_type_hyper_edges, hyper = T), "The values in the first two columns of `x` must be of the same type and cannot be `NULL`, `NA`, or recursive values." ) loop_hyper_edges <- data.frame( from = I(list(c("a", "b"))), to = I(list(c("a", "b"))) ) expect_error( as.network(loop_hyper_edges, hyper = TRUE), "`loops` is `FALSE`, but `x` contains loops." ) }) test_that("edge/vertex-less networks return empty data frames", { empty_g <- network.initialize(0) expect_identical( nrow(as.data.frame(empty_g)), 0L ) expect_identical( ncol(as.data.frame(empty_g)), 2L ) expect_identical( ncol(as.data.frame(empty_g, attrs_to_ignore = NULL)), 3L ) expect_identical( nrow(as.data.frame(empty_g, unit = "vertices")), 0L ) expect_identical( ncol(as.data.frame(empty_g, unit = "vertices")), 1L ) expect_identical( ncol(as.data.frame(empty_g, unit = "vertices", attrs_to_ignore = NULL)), 2L ) }) test_that("deleted edges/vertices and na attributes are handled correctly", { na_edge_df <- data.frame(.tail = c("b", "c", "c", "d", "d", "e"), .head = c("a", "b", "a", "a", "b", "a"), na = c(rep(FALSE, 5), TRUE), stringsAsFactors = FALSE) na_vertex_df <- data.frame(vertex.names = letters[1:5], na = c(rep(FALSE, 4), TRUE), stringsAsFactors = FALSE) na_g <- as.network(na_edge_df, vertices = na_vertex_df) expect_identical( as.data.frame(na_g, na.rm = FALSE, attrs_to_ignore = NULL), na_edge_df ) expect_identical( as.data.frame(na_g, unit = "vertices", na.rm = FALSE, attrs_to_ignore = NULL), na_vertex_df ) delete.edges(na_g, 1) expect_identical( `rownames<-`(na_edge_df[-c(1, which(na_edge_df$na)), ], NULL), as.data.frame(na_g, attrs_to_ignore = NULL) ) delete.vertices(na_g, 1) expect_identical( `rownames<-`(na_vertex_df[-c(1, which(na_vertex_df$na)), ], NULL), as.data.frame(na_g, unit = "vertices", attrs_to_ignore = NULL) ) }) test_that("as.data.frame.network() handles missing vertex.names ", { # addresses https://github.com/statnet/network/issues/43 nw_no_vertex.names <- network.initialize(5) delete.vertex.attribute(nw_no_vertex.names, "vertex.names") expect_identical( as.data.frame(nw_no_vertex.names, unit = "vertices"), data.frame(vertex.names = as.character(1:5)) ) }) network/tests/testthat/test-i22-summary-character.R0000644000176200001440000000112513740520334022066 0ustar liggesuserstd <- data.frame( lettres = letters[1:10], values = 1:10, stringsAsFactors = FALSE ) # Correct output correct <- structure( c( "Length:10 ", "Class :character ", "Mode :character ", NA, NA, NA, "Min. : 1.00 ", "1st Qu.: 3.25 ", "Median : 5.50 ", "Mean : 5.50 ", "3rd Qu.: 7.75 ", "Max. :10.00 " ), .Dim = c(6L, 2L), .Dimnames = list(c("", "", "", "", "", ""), c(" lettres", " values")), class = "table" ) actual <- summary(td) expect_identical(actual, correct) network/tests/testthat/test-mixingmatrix.R0000644000176200001440000001404014057014734020571 0ustar liggesusers# Directed networks ------------------------------------------------------- test_that("mixingmatrix() just works on a directed network", { net <- network.initialize(4, directed=TRUE) net[1,2] <- net[3,4] <- 1 net %v% "a" <- c(1,1,2,2) mm <- mixingmatrix(net, "a") expect_type(mm, "integer") expect_s3_class(mm, c("mixingmatrix", "table"), exact=TRUE) expect_true(is.directed(mm)) expect_false(is.bipartite(mm)) }) test_that("mixingmatrix() works on emon$Texas (directed)", { data(emon, package="network") a <- get.vertex.attribute(emon$Texas, "Location") el <- as.matrix(emon$Texas, matrix.type="edgelist") emm <- table(From=a[el[,1]], To=a[el[,2]]) expect_equivalent( as.integer(mixingmatrix(emon$Texas, "Location")), as.integer(emm) ) }) test_that("NA rows & cols are present for emon$MtSi unless useNA='no'", { mm.no <- mixingmatrix(emon$MtSi, "Formalization", useNA="no") expect_type(mm.no, "integer") expect_identical(dim(mm.no), c(2L,2L)) mm.default <- mixingmatrix(emon$MtSi, "Formalization") mm.ifany <- mixingmatrix(emon$MtSi, "Formalization", useNA="ifany") mm.always <- mixingmatrix(emon$MtSi, "Formalization", useNA="always") expect_identical(mm.ifany, mm.default) expect_identical(mm.ifany, mm.always) expect_identical(dim(mm.ifany), c(3L, 3L)) expect_identical( mm.default, structure( c(19L, 4L, 1L, 4L, 0L, 0L, 4L, 1L, 0L), .Dim = c(3L, 3L), .Dimnames = list(From = c("1", "2", NA), To = c("1", "2", NA)), class = c("mixingmatrix", "table"), directed = TRUE, bipartite = FALSE ) ) } ) test_that("mixingmatrix(directed with categories without incident ties)", { net <- network.initialize(4, directed = TRUE) net %v% "a" <- c(1,1,2,3) net[1,2] <- net[1,3] <- 1 # no ties incident on a=3 mm <- mixingmatrix(net, "a") expect_type(mm, "integer") expect_equivalent( mm, structure( matrix(as.integer(c(1,0,0, 1,0,0, 0,0,0)), 3, 3), dimnames = list(From=1:3, To=1:3), class = c("mixingmatrix", "table") ) ) }) test_that("mixingmatrx() warns on exclude=NULL", { net <- network.initialize(4, directed=TRUE) net[1,2] <- net[3,4] <- 1 net %v% "a" <- c(1,1,2,2) expect_warning( r <- mixingmatrix(net, "a", exclude=NULL), regexp = "passing `exclude=NULL`" ) expect_identical(r, mixingmatrix(net, "a")) }) # Undirected networks ----------------------------------------------------- test_that("mixingmatrix() just works on a undirected network", { net <- network.initialize(4, directed=FALSE) net[1,2] <- net[1,3] <- 1 net %v% "a" <- c(1,1, 2,2) mm <- mixingmatrix(net, "a") expect_type(mm, "integer") expect_equivalent( mm, structure( matrix(as.integer(c(1,1,1,0)), 2, 2), dimnames = list(From = 1:2, To = 1:2), class = c("mixingmatrix", "table") ) ) expect_false(is.directed(mm)) expect_false(is.bipartite(mm)) }) test_that("NA rows & cols are shown for undirected net unless useNA='no'", { net <- network.initialize(2, directed=FALSE) net %v% "a" <- c(1, NA) net[1,2] <- 1 mm.default <- mixingmatrix(net, "a") mm.ifany <- mixingmatrix(net, "a", useNA="ifany") mm.always <- mixingmatrix(net, "a", useNA="always") expect_identical(mm.default, mm.ifany) expect_identical(mm.default, mm.always) expect_identical( mm.default, structure( c(0L, 1L, 1L, 0L), .Dim = c(2L, 2L), class = c("mixingmatrix", "table"), .Dimnames = list(From = c("1", NA), To = c("1", NA)), directed = FALSE, bipartite = FALSE ) ) mm.no <- mixingmatrix(net, "a", useNA="no") expect_type(mm.no, "integer") expect_identical(dim(mm.no), c(1L, 1L)) }) # Bipartite networks ------------------------------------------------------ am <- matrix(0, 5, 5) am[1,3] <- am[1,4] <- am[2,3] <- am[2,5] <- 1 net <- as.network(am, directed=FALSE, bipartite=2) net %v% "mode" <- c(1,1,2,2,2) net %v% "a" <- c(1,2,3,4,4) net %v% "withNA" <- c(1,2,NA, 4,NA) set.vertex.attribute(net, "p1", value = c(20, 30), v = 1:2) set.vertex.attribute(net, "p2", value = c(0.1, 0.2, 0.1), v = 3:5) # plot(net, vertex.col="mode", displaylabels=TRUE) test_that("mixingmatrix for bipartite net with expand.bipartite=FALSE is correct", { # On `mode` so all ties between groups expect_silent( mm <- mixingmatrix(net, "mode", expand.bipartite = FALSE) ) expect_type(mm, "integer") expect_false(is.directed(mm)) expect_true(is.bipartite(mm)) expect_equivalent( mm, structure( matrix(4L, 1, 1), dimnames = list(From = 1, To = 2), class = "mixingmatrix" ) ) # On `a` expect_silent( mm <- mixingmatrix(net, "a", expand.bipartite = FALSE) ) expect_type(mm, "integer") expect_false(is.directed(mm)) expect_true(is.bipartite(mm)) expect_equivalent( mm, structure( matrix(as.integer(c(1,1, 1,1)), 2, 2), dimnames = list(From = 1:2, To=3:4), class = "mixingmatrix" ) ) }) test_that("mixingmatrix for bipartite net with expand.bipartite=TRUE is correct", { # On `mode` expect_silent( mm <- mixingmatrix(net, "mode", expand.bipartite = TRUE) ) expect_type(mm, "integer") expect_equivalent( mm, structure( matrix(as.integer(c(0,0, 4,0)), 2, 2), dimnames = list(From = 1:2, To=1:2), class = "mixingmatrix" ) ) # On `a` expect_silent( mm <- mixingmatrix(net, "a", expand.bipartite = TRUE) ) expect_identical(dim(mm), c(4L, 4L)) expect_identical( as.integer(mm), as.integer(c(0,0,0,0, 0,0,0,0, 1,1,0,0, 1,1,0,0)) ) }) test_that("NA rows & cols are shown for bipartite net unless useNA='no'", { expect_silent( mm.default <- mixingmatrix(net, "withNA") ) expect_silent( mm.no <- mixingmatrix(net, "withNA", useNA="no") ) expect_silent( mm.always <- mixingmatrix(net, "withNA", useNA="always") ) expect_identical(mm.default, mm.always) expect_identical( as.integer(mm.default), as.integer(c(1,0,0, 1,2,0)) ) expect_identical(dim(mm.no), c(2L, 1L)) expect_identical( as.integer(mm.no), as.integer(c(1, 0)) ) }) network/tests/testthat/test-indexing.R0000644000176200001440000000204313740520334017652 0ustar liggesuserstest_that("proper error messages for out of bounds indexing (unipartite)",{ nw <- network.initialize(10) expect_error(nw[1,100], "subscript out of bounds") expect_error(nw[1,100] <- 1, "subscript out of bounds") expect_error(nw[100,1], "subscript out of bounds") expect_error(nw[100,1] <- 1, "subscript out of bounds") }) test_that("proper error messages (or lack thereof) for out of bounds indexing (bipartite)",{ nw <- network.initialize(10, bipartite=3, directed=FALSE) expect_error(nw[1,3], "subscript out of bounds") expect_error(nw[1,3] <- 1, "subscript out of bounds") expect_error(nw[4,5], "subscript out of bounds") expect_error(nw[4,5] <- 1, "subscript out of bounds") expect_error(nw[4,1], NA) expect_error(nw[5,3], NA) }) test_that("wildcard assignment (bipartite)",{ nw <- network.initialize(10, bipartite=3, directed=FALSE) nw[1,] <- 1 expect_equal(network.edgecount(nw), 7) # 7 nw[,4] <- 1 expect_equal(network.edgecount(nw), 9) # 7 + 3 - 1 nw[,] <- 1 expect_equal(network.edgecount(nw), 21) # 3*7 }) network/tests/testthat/test-as.edgelist.R0000644000176200001440000000500113740520334020244 0ustar liggesuserstest<-network.initialize(5) add.edges(test,5,1) add.edges(test,1,5) set.edge.attribute(test,'value',c('a','b')) set.edge.attribute(test,'weight',10:11) expect_equal( as.matrix.network.edgelist(test), structure(c(5L, 1L, 1L, 5L), .Dim = c(2L, 2L), n = 5, vnames = 1:5) ) # sort order should be different if(Sys.getenv("_R_CLASS_MATRIX_ARRAY_") == "" & getRversion() < "4.0.0"){ expect_equal( as.edgelist(test), structure(c(1L, 5L, 5L, 1L), .Dim = c(2L, 2L), n = 5, vnames = 1:5, directed = TRUE, bipartite = FALSE, loops = FALSE, class = c("matrix_edgelist", "edgelist","matrix")) ) }else{ expect_equal( as.edgelist(test), structure(c(1L, 5L, 5L, 1L), .Dim = c(2L, 2L), n = 5, vnames = 1:5, directed = TRUE, bipartite = FALSE, loops = FALSE, class = c("matrix_edgelist", "edgelist","matrix","array")) ) } expect_true(is.edgelist(as.edgelist(test))) # numeric attribute expect_equal(as.matrix.network.edgelist(test,attrname='weight'),structure(c(5L, 1L, 1L, 5L, 10L, 11L), .Dim = 2:3, n = 5, vnames = 1:5)) # character attribute NOTE makes the matrix character as well expect_equal(as.matrix.network.edgelist(test,attrname='value'),structure(c('5', '1', '1', '5', 'a', 'b'), .Dim = 2:3, n = 5, vnames = 1:5)) # character attribute with tibble output: does not make matrix character expect_equal(as.edgelist(test,attrname='value', output="tibble"), structure(list(.tail = c(1L, 5L), .head = c(5L, 1L), value = c("b", "a")), row.names = c(NA, -2L), class = c("tibble_edgelist", "edgelist", "tbl_df", "tbl", "data.frame"), n = 5, vnames = 1:5, directed = TRUE, bipartite = FALSE, loops = FALSE) ) undir<-network.initialize(5,directed=FALSE) add.edges(undir,5,1) # direction will be swapped to tail < head expect_equal(as.edgelist(undir)[,], c(1,5)) # empty network as.edgelist(network.initialize(0)) # deleted edges deledge<-network.initialize(5) add.edges(deledge,1:3,2:4) delete.edges(deledge,2) if(Sys.getenv("_R_CLASS_MATRIX_ARRAY_")=="" & getRversion() < "4.0.0"){ expect_equal( as.edgelist(deledge), structure(c(1L, 3L, 2L, 4L), .Dim = c(2L, 2L), n = 5, vnames = 1:5, directed = TRUE, bipartite = FALSE, loops = FALSE, class = c("matrix_edgelist", "edgelist", "matrix")) ) }else{ expect_equal( as.edgelist(deledge), structure(c(1L, 3L, 2L, 4L), .Dim = c(2L, 2L), n = 5, vnames = 1:5, directed = TRUE, bipartite = FALSE, loops = FALSE, class = c("matrix_edgelist", "edgelist", "matrix", "array")) ) } network/tests/testthat/test-plot.R0000644000176200001440000000704413740520334017031 0ustar liggesusers# various tests for network plotting functions # mostly recent functionality added by skyebend # Open null device pdf(file = NULL, onefile = TRUE) dev_id <- dev.cur() # ----- test edge labels ------ ymat<-matrix(c(0,1,2,3, 0,0,0,0, 1,0,0,0, 0,0,0,0),ncol=4) ynet<-network(ymat,ignore.eval=FALSE,names.eval='weight') # don't do anything if no value given plot(ynet,edge.label.col='blue',edge.label.cex='weight') # use edge ids is if edge.label=TRUE plot(ynet,edge.label=TRUE) plot(ynet,edge.label='weight',edge.label.col='blue',edge.label.cex='weight') # labels for curved edges plot(ynet,edge.label='weight',edge.label.col='blue',edge.label.cex='weight',usecurve=TRUE) plot(ynet,edge.label='weight',edge.label.col='blue',edge.label.cex='weight',usecurve=TRUE,edge.curve=0.5) data(emon) par(mar=c(0,0,0,0)) plot(emon[[5]],edge.label=TRUE,edge.label.cex=0.6,edge.col='gray',edge.lwd=(emon[[5]]%e%'Frequency')*2) # test for labeling network with no edges #521 plot(network.initialize(1),edge.label=TRUE) # test color stuff col.list<-c('red','#800000','#80000505',NA) # test is.color for vector NA processing bug #491 if(!all(is.color(col.list)[1:3] & is.na(is.color(col.list)[4]))){ stop('is.color did not correctly recognize colors and NA values in a character vector') } col.list<-list('red','#800000','#80000505',NA) # test is.color for list NA processing bug #491 if(!all(is.color(col.list)[1:3] & is.na(is.color(col.list)[4]))){ stop('is.color did not correctly recognize colors and NA values in a list') } # ------------ as.color -------- expect_equal(as.color(c('a','b','c')),1:3) # character expect_equal(as.color(1:3),1:3) # numeric expect_equal(as.color(as.factor(c('a','b','c'))),1:3) # factor expect_equal(as.color(c('red','green','blue')),c('red','green','blue')) # color name expect_equal(as.color(c(1,0.5,0)),c("#FFFFFF", "#808080", "#000000"))# real valued (gray) # transparency/ opacity expect_equal(as.color(c('red','green','blue'),0.5),c("#FF000080", "#00FF0080", "#0000FF80")) if(R.Version()$major <= 3) expect_equal(as.color(1:3,0.5),c("#00000080", "#FF000080", "#00CD0080")) else expect_equal(as.color(1:3,0.5),c("#00000080", "#DF536B80", "#61D04F80")) expect_error(as.color(c('red','green','blue'),1.5),regexp = 'opacity parameter must be a numeric value in the range 0 to 1') # ----- plot fixes ---- plot(network.initialize(5),vertex.lwd=c(1,2,3,5,10)) # test for expansion of label attribute name bug #785 # this should produce a plot with vertices labeled A to E, instead # used to plot single vertex is labeled with "Label' test<-network.initialize(5) set.vertex.attribute(test,'Label',LETTERS[1:5]) plot(test,label='Label') # replicates non-matching label name plot(test,label='A') plot(test,label=1) # should error if all values are missing #set.vertex.attribute(test,'bad',NA,v=1:3) #plot(test,label='bad') # tests for #673 plot.network.default gives error when rendering labels if two connected vertices have the same position test<-network.initialize(2) test[1,2]<-1 plot(test,coord=cbind(c(1,1),c(1,1)),jitter=FALSE,displaylabels=TRUE) test<-network.initialize(3) test[1,2:3]<-1 plot(test,coord=cbind(c(1,1,2),c(1,1,2)),jitter=FALSE,displaylabels=TRUE) # tests for polygon sizes/sides plot(network.initialize(7),vertex.sides=c(50,4,3,2,1,0,NA),vertex.cex=40,coord=matrix(0,ncol=7,nrow=7),jitter=F,vertex.col='#CCCCCC00',vertex.border =c('red','green','blue','orange')) plot(network.initialize(7),vertex.sides=c(50,4,3,2,1,0,NA),vertex.cex=0) plot(network.initialize(7),vertex.sides=c(50,4,3,2,1,0,NA),vertex.cex=NA) # close the device dev.off(which = dev_id) network/tests/testthat/test-read.paj.R0000644000176200001440000002341213740520334017534 0ustar liggesusers# test for reading pajek formatted files # test for case of verticse, but no edges/arcs tmptest<-tempfile() cat("*Vertices 2 1 1231062 2 1231095 *Arcs *Edges ",file=tmptest) noEdges<-read.paj(tmptest) expect_equal(network.size(noEdges),2) expect_equal(network.edgecount(noEdges),0) # check arcs vs edges parsing # arcs only tmptest<-tempfile() cat("*Vertices 3 1 'A' 2 'B' 3 'C' *Arcs 1 2 1 1 3 1 ",file=tmptest) arcsOnly<-read.paj(tmptest) expect_true(is.directed(arcsOnly)) expect_equal(network.edgecount(arcsOnly),2) # edges only tmptest<-tempfile() cat('*Vertices 9 1 "1" 0.3034 0.7561 2 "2" 0.4565 0.6039 3 "3" 0.4887 0.8188 4 "4" 0.5687 0.4184 5 "5" 0.3574 0.4180 6 "6" 0.7347 0.2678 7 "7" 0.9589 0.3105 8 "8" 0.8833 0.1269 9 "9" 0.7034 0.0411 *Arcs *Edges 1 2 1 1 3 1 2 3 1 2 4 1 2 5 1 4 5 1 4 6 1 6 7 1 6 8 1 6 9 1 7 8 1 8 9 1 ',file=tmptest) edgesOnly<-read.paj(tmptest) expect_false(is.directed(edgesOnly)) expect_equal(network.edgecount(edgesOnly),12) # both arcs and edges # network will be directed, each *edges record will create one arc in each direction tmptest<-tempfile() cat("*Vertices 4 1 'A' 2 'B' 3 'C' 4 'D' *Arcs 1 2 1 1 3 1 *Edges 3 4 1 ",file=tmptest) arcsNEdges<-read.paj(tmptest) expect_true(is.directed(arcsNEdges)) expect_equal(network.edgecount(arcsNEdges),4) as.matrix(arcsNEdges) # ----- error testing tmptest<-tempfile() cat("*Vertices 2 1 'A' 2 'B' *Arcs 1 ",file=tmptest) expect_error(read.paj(tmptest),regexp = 'does not appear to have the required') tmptest<-tempfile() cat("*Vertices 2 1 'A' 2 'B' *Arcs 1 A 1 ",file=tmptest) expect_error(suppressWarnings(read.paj(tmptest)),regexp = 'contains non-numeric or NA values') tmptest<-tempfile() cat("*Vertices 2 1 'A' 2 'B' *Arcs 1 2.5 1 ",file=tmptest) expect_error(read.paj(tmptest),regexp = 'contains non-integer values') # check vertex graphic attribute fill-in tmptest<-tempfile() cat("*Vertices 4 1 'A' 0 0 0 box 2 'B' 0 0 0 3 'C' 0 0 0 4 'D' 0 0 0 ellipse *Arcs 1 2 1 1 3 1 ",file=tmptest) fillIn<-read.paj(tmptest) expect_equal(fillIn%v%'shape',c('box','box','box','ellipse')) # test stuff in file comments ########## but multirelational ############ only ~200 nodes #GulfLDays.net #GulfLMonths.net #GulfLDow.net #gulfAllDays.net #GulfADays.zip #gulfAllMonths.net #GulfAMonths.zip #LevantDays.net #LevantMonths.net #BalkanDays.net #BalkanMonths.net #arcs and edges both present search for " #these have both arc and edge lines " or "URL has a net file" #Graph drawing competition page (GD) #C95,C95,B98,A99,C99,A99m #things to do: #handle ragged array .net files like "CSphd.net" DONE!! #handel two mode networks DONE!! #handle mix of edges and arcs DONE!! #handle multirelational pajek files #issue with read.table and number.cols and fill...SanJuanSur_deathmessage.net has one row with 8 all the rest (including the first 5 have 5) # this file has character encoding issues scotland<-tempfile('scotland',fileext='.zip') download.file( 'http://vlado.fmf.uni-lj.si/pub/networks/data/esna/scotland.zip', scotland, quiet = TRUE) scotpaj<-tempfile('Scotland',fileext='.paj') con <- unz(scotland,'Scotland.paj') cat( readLines(con, encoding = "UTF-8"), sep='\n', file = scotpaj ) close(con) scotproj<-read.paj(scotpaj) # produces two element list, containing networks and partitions expect_equal(names(scotproj),c("networks","partitions")) expect_equal(network.size(scotproj[[1]][[1]]),244) expect_equal(names(scotproj$partitions),c("Affiliation.partition.of.N1.[108,136]","Industrial_categories.clu")) A95net<-read.paj("http://vlado.fmf.uni-lj.si/pub/networks/data/GD/gd95/A95.net") expect_equal(network.size(A95net),36) expect_equal(network.vertex.names(A95net)[1:5],c("MUX","INSTRUCTION BUFFER (4 x 16)", "RCV","DRV","ROM REG")) # test reading a .paj project file bkfratProj<-read.paj('http://vlado.fmf.uni-lj.si/pub/networks/data/ucinet/bkfrat.paj') # should have two networks expect_equal(sapply(bkfratProj,class),c('network','network'),check.attributes=FALSE) # .. with wierd names expect_equal(names(bkfratProj),c('UciNet\\BKFRAT.DAT : BKFRAB','UciNet\\BKFRAT.DAT : BKFRAC')) # and 58 vertices expect_equal(sapply(bkfratProj,network.size),c(58,58),check.attributes=FALSE) expect_equal(sapply(bkfratProj,network.edgecount),c(1934,3306),check.attributes=FALSE) #check edge values and attribute naming expect_equal((bkfratProj[[1]]%e%"UciNet\\BKFRAT.DAT : BKFRAB")[1900:1934],c(1, 1, 1, 5, 2, 4, 2, 1, 3, 1, 3, 1, 2, 5, 1, 1, 1, 2, 1, 2, 2, 1, 6, 2, 1, 2, 2, 1, 1, 1, 1, 3, 3, 1, 1)) # check vert attrs expect_equal(list.vertex.attributes(bkfratProj[[1]]),c('na','vertex.names','x','y','z')) # check network attrs expect_equal(bkfratProj[[1]]%n%'title',"UciNet\\BKFRAT.DAT : BKFRAB") expect_equal(bkfratProj[[2]]%n%'title',"UciNet\\BKFRAT.DAT : BKFRAC") # check loop flagging tmptest<-tempfile() cat("*Vertices 2 1 'A' 2 'B' *Arcs 1 1 1 ",file=tmptest) loopTest<-read.paj(tmptest,verbose=FALSE) expect_true(has.loops(loopTest)) # check edge.name argument tmptest<-tempfile() cat("*Vertices 2 1 'A' 2 'B' *Arcs 1 1 1 ",file=tmptest) loopTest<-read.paj(tmptest,verbose=FALSE,edge.name='weight') expect_equal(list.edge.attributes(loopTest),c('na','weight')) # the rest of these will take longer, so including in opttest block so won't run on CRAN require(statnet.common) opttest(testvar = "ENABLE_statnet_TESTS",{ # ----- examples from http://vlado.fmf.uni-lj.si/pub/networks/doc/ECPR/08/ECPR01.pdf --- GraphSet<-read.paj('http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/GraphSet.net') expect_true(is.directed(GraphSet)) expect_equal(network.edgecount(GraphSet),27) # network contains some repeated edges expect_true(is.multiplex(GraphSet)) expect_equal(network.vertex.names(GraphSet),letters[1:12]) Tina<-read.paj('http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/TinaSet.net') # arcslist GraphList<-read.paj('http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/GraphList.net') # http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/TinaList.net # arcslist # matrix GraphMat <-read.paj('http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/GraphMat.net') expect_equal(network.vertex.names(GraphMat),letters[1:12]) # check that edge attribute created and parsed correctly expect_equal(as.matrix(GraphMat,attrname='GraphMat')[3,7],2) # partition TinaPaj<-read.paj('http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/Tina.paj') expect_equal(class(TinaPaj$partitions),'data.frame') expect_equal( TinaPaj$partitions[,1],c(2,1,2,2,2,2,2,2,3,3,3),use.names=FALSE) expect_true(is.network(TinaPaj$networks$Tina)) # --- crude timing info -- # by default timing info should be added as attribute timetest<-read.paj('http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/Time.net') expect_equal(timetest%e%'pajekTiming',c("[7]","[6-8]")) expect_equal(timetest%v%'pajekTiming',c("[5-10,12-14]", "[1-3,7]", "[4-*]")) expect_true(setequal(list.vertex.attributes(timetest),c('na','pajekTiming','vertex.names'))) # no x or y expect_true(setequal(list.edge.attributes(timetest),c('na','pajekTiming','Time'))) # test converting to networkDynamic format timetestNd<-read.paj('http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/Time.net',time.format='networkDynamic') expect_equal(class(timetestNd),c('networkDynamic','network')) # check that activiy matrices are built as expected expect_equal(get.vertex.attribute(timetestNd,'active',unlist=FALSE),list(structure(c(5, 12, 11, 15), .Dim = c(2L, 2L)), structure(c(1, 7, 4, 8), .Dim = c(2L, 2L)), structure(c(4, Inf), .Dim = 1:2))) expect_equal(get.edge.attribute(timetestNd,'active',unlist=FALSE),list(structure(c(7, 8), .Dim = 1:2), structure(c(6, 9), .Dim = 1:2))) # read a *big* one http://vlado.fmf.uni-lj.si/pub/networks/data/CRA/Days.zip # 1.3 Mb, 13k vertices, 256K lines. # days<-tempfile('days',fileext='.zip') # download.file('http://vlado.fmf.uni-lj.si/pub/networks/data/CRA/Days.zip',days) # terrorTerms<-read.paj(unz(days,'Days.net'),verbose=TRUE,time.format='networkDynamic',edge.name='count') # multiple networks sampson<-read.paj('http://vlado.fmf.uni-lj.si/pub/networks/pajek/data/Sampson.net') lapply(sampson,class) # for some reason it is a formula? expect_equal(names(sampson$networks),c("SAMPLK1", "SAMPLK2", "SAMPLK3", "SAMPDLK", "SAMPES","SAMPDES","SAMPIN","SAMPNIN","SAMPPR","SAMNPR")) # multiple networks in arcslist format # sampsonL<-read.paj('http://vlado.fmf.uni-lj.si/pub/networks/pajek/data/SampsonL.net') # two-mode sandi<-read.paj('http://vlado.fmf.uni-lj.si/pub/networks/data/2mode/sandi/sandi.net') expect_true(is.bipartite(sandi)) expect_equal(sandi%n%'bipartite',314) Davis<-read.paj('http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/Davis.paj') # two-mode expect_equal(Davis$networks[[1]]%n%'bipartite',18) # lots of edge and vertex attributes A96<-read.paj('http://vlado.fmf.uni-lj.si/pub/networks/data/GD/gd96/A96.net') expect_equal(network.size(A96),1096) expect_equal(list.vertex.attributes(A96),c("bw","fos","na","shape","vertex.names", "x","x_fact","y","y_fact")) # note no z attribute expect_equal(head(A96%v%'shape'),c("box","ellipse", "ellipse", "ellipse", "ellipse", "ellipse")) # check edge attribute parsing expect_equal(list.edge.attributes(A96),c("A96", "fos", "l" , "lr", "na", "s", "w" )) # l is the only one with unique values expect_equal(head(A96%e%'l'),c("a", "s","n","r","s","t")) }) # end of non-cran tests # temporal versions http://vlado.fmf.uni-lj.si/pub/networks/data/KEDS/KEDS.htm # temporal events data (not supported) # http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/Time.tim # http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/Friends.tim network/tests/testthat/test-networks.R0000644000176200001440000000362313740520334017726 0ustar liggesusers# ----- checks for network edgecount ------ test<-network.initialize(4) # directed expect_equal(network.dyadcount(test),12) # undirected test%n%'directed'<-FALSE expect_equal(network.dyadcount(test),6) # loops allowed test%n%'loops'<-TRUE #undirected expect_equal(network.dyadcount(test),10) # directed test%n%'directed'<-TRUE expect_equal(network.dyadcount(test),16) # directed bipartite test%n%'loops'<-FALSE test%n%'bipartite'<-1 expect_equal(network.dyadcount(test),6) # undirected bipartite test%n%'directed'<-FALSE expect_equal(network.dyadcount(test),3) # NA values test[1,2]<-NA expect_equal(network.dyadcount(test,na.omit = TRUE),2) # ----- checks for dyads eids ----- data(emon) el<-as.matrix.network.edgelist(emon[[1]]) expect_equal(get.dyads.eids(emon[[1]],el[,1],el[,2]),as.list(1:83)) expect_equal(get.dyads.eids(emon[[1]],el[5:10,1],el[5:10,2]),as.list(5:10)) expect_error(get.dyads.eids(emon[[1]],1,2:3),regexp = 'heads and tails vectors must be the same length') expect_error(get.dyads.eids(network.initialize(0),1,2),regexp = 'invalid vertex id in heads or tails vector') mult<-network.initialize(5,multi=TRUE) add.edges(mult,1,2) add.edges(mult,1,2) expect_warning(expect_true(is.na(get.dyads.eids(mult,1,2)[[1]])),regexp = 'multiple edge ids for dyad') expect_equal(get.dyads.eids(network.initialize(0),numeric(0),numeric(0)), list()) expect_equal(get.dyads.eids(network.initialize(5),tails=1:2,heads=3:4),list(numeric(0),numeric(0))) # check oposite matching for undirected nets undir<-network.initialize(3,directed=FALSE) undir[1,2]<-1 expect_equal(get.dyads.eids(undir,2,1),list(1)) expect_equal(get.dyads.eids(undir,1,2),list(1)) undir%n%'directed'<-TRUE expect_equal(get.dyads.eids(undir,2,1),list(integer(0))) expect_equal(get.dyads.eids(undir,1,2),list(1)) expect_equal(get.dyads.eids(undir,2,1,neighborhood='in'),list(1)) expect_equal(get.dyads.eids(undir,1,2,neighborhood='in'),list(integer(0))) network/tests/general.tests.R0000644000176200001440000001702413357022000016002 0ustar liggesusers#The following battery of tests is intended to verify the functionality of #the network library library(network) # ----- check assigning multiple attribute values in a single call ------ test<-network.initialize(3) set.vertex.attribute(test,c('a','b'),c(1,2)) if(!all(test%v%'a'==c(1,1,1) & test%v%'b'==c(2,2,2))){ stop('setting multiple attribute values with set.vertex.attribute failed') } test<-network.initialize(3) set.vertex.attribute(test,list('a','b'),c(1,2)) if(!all(test%v%'a'==c(1,1,1) & test%v%'b'==c(2,2,2))){ stop('setting multiple attribute values with set.vertex.attribute failed') } test<-network.initialize(3) set.vertex.attribute(test,c('a','b'),list(c(1,2,3),c(4,5,6))) if(!all(test%v%'a'==c(1,2,3) & test%v%'b'==c(4,5,6))){ stop('setting multiple attribute values with set.vertex.attribute failed') } test<-network.initialize(3) set.vertex.attribute(test,c('a','b'),list(list(1,2,3),list(4,5,6))) if(!all(test%v%'a'==c(1,2,3) & test%v%'b'==c(4,5,6))){ stop('setting multiple attribute values with set.vertex.attribute failed') } test<-network.initialize(3) obj<-list(one='a complex object',two=c('with muliple','parts')) set.vertex.attribute(test,c('a','b'),list(list(as.list(obj)),list(as.list(obj)))) if(!all(all.equal(get.vertex.attribute(test,'a',unlist=FALSE)[[1]],obj) & all.equal(get.vertex.attribute(test,'b',unlist=FALSE)[[1]],obj))){ stop('setting multiple attribute values with list values in set.vertex.attribute failed') } # check assignment to list of networks net <- network.initialize(2) netlist <- list(net) set.network.attribute(netlist[[1]],"test","a value") if (!"test" %in% list.network.attributes(netlist[[1]])) stop('assignment to list of networks failed') # test multiple assignment for network test<-network.initialize(3) set.network.attribute(test,c("a","b"),1:2) if (!all(test%n%'a'==1,test%n%'b'==2)){ stop('mulltiple attribute assignment failed for set.network.attribute') } test<-network.initialize(3) set.network.attribute(test,list("a","b"),as.list(1:2)) if (!all(test%n%'a'==1,test%n%'b'==2)){ stop('mulltiple attribute assignment failed for set.network.attribute') } # test multiple assignment for edges test<-network.initialize(3) add.edges(test,tail=1:3,head=c(2,3,1)) net<-test set.edge.attribute(net,c("a","b"),1:2) if (!all(net%n%'a'==1,net%n%'b'==2)){ stop('mulltiple attribute assignment failed for set.edge.attribute') } net<-test set.edge.attribute(net,c('a','b'),list(c(1,2,3),c(4,5,6))) if(!all(net%e%'a'==c(1,2,3) & net%e%'b'==c(4,5,6))){ stop('setting multiple attribute values with set.edge.attribute failed') } net<-test set.edge.attribute(net,c('a','b'),list(list(1,2,3),list(4,5,6))) if(!all(net%e%'a'==c(1,2,3) & net%e%'b'==c(4,5,6))){ stop('setting multiple attribute values with set.edge.attribute failed') } net<-test obj<-list(one='a complex object',two=c('with muliple','parts')) set.edge.attribute(net,c('a','b'),list(list(as.list(obj)),list(as.list(obj)))) if(!all(all.equal(get.edge.attribute(net,'a',unlist=FALSE)[[1]],obj) & all.equal(get.edge.attribute(net,'b',unlist=FALSE)[[1]],obj))){ stop('setting multiple attribute values with list values in set.edge.attribute failed') } # ---- checks for get.edge.attribute overloading and omit args ---- net<-network.initialize(3) add.edges(net,c(1,2,3),c(2,3,1)) set.edge.attribute(net,'test',"a") if(!all(get.edge.attribute(net,'test')==c("a","a","a"))){stop("overloading of get.edge.attribute to get.edge.value not working correctly ")} # check list output of get.edge.attribute with deleted.edges.omit delete.edges(net,2) set.edge.attribute(net,'foo','bar',1) if(!identical(list('bar',NULL,NULL),get.edge.attribute(net,'foo',unlist=FALSE, deleted.edges.omit = FALSE))){ stop("deleted.edges.omit argument causing bad return values in get.edge.attribute ") } if(!identical(list('bar',NULL),get.edge.attribute(net,'foo',unlist=FALSE, deleted.edges.omit = TRUE))){ stop("deleted.edges.omit argument causing bad return values in get.edge.attribute ") } # check unlisted output of get.edge.attribute with na.omit and deleted.edges.omit if(!identical(c('bar'),get.edge.attribute(net,'foo',unlist=TRUE,deleted.edges.omit=TRUE))){ stop("omission argument causing bad return values in get.edge.attribute") } if(!identical(c('bar'),get.edge.attribute(net,'foo',unlist=TRUE,deleted.edges.omit=TRUE))){ stop("omission arguments causing bad return values in get.edge.attribute") } # check for null.na recoding of non-set attributes if(!identical(c('bar'),get.edge.attribute(net,'foo',unlist=TRUE,null.na=FALSE))){ stop("null.na arguments causing bad return values in get.edge.attribute") } if(!identical(c('bar',NA),get.edge.attribute(net,'foo',unlist=TRUE,null.na=TRUE))){ stop("null.na arguments causing bad return values in get.edge.attribute") } if(!identical(list('bar',NULL,NULL),get.edge.attribute(net,'foo',unlist=FALSE,null.na=FALSE))){ stop("null.na arguments causing bad return values in get.edge.attribute") } if(!identical(list('bar',NULL,NA),get.edge.attribute(net,'foo',unlist=FALSE,null.na=TRUE))){ stop("null.na arguments causing bad return values in get.edge.attribute") } #mark an edge as missing to test na.omit set.edge.attribute(net,'na',TRUE,e=1) # check that values corresponding to missing edges are ommited if(!identical(list('bar',NULL,NULL),get.edge.attribute(net,'foo',unlist=FALSE,na.omit=FALSE))){ stop("na.omit argument causing bad return values in get.edge.attribute") } if(!identical(list(NULL,NULL),get.edge.attribute(net,'foo',unlist=FALSE,na.omit=TRUE))){ stop("na.omit argument causing bad return values in get.edge.attribute") } if(!identical(c('bar'),get.edge.attribute(net,'foo',unlist=TRUE,na.omit=FALSE))){ stop("na.omit argument causing bad return values in get.edge.attribute") } if(!identical(NULL,get.edge.attribute(net,'foo',unlist=TRUE,na.omit=TRUE))){ stop("na.omit argument causing bad return values in get.edge.attribute") } # check for behavior when querying the 'na' attribute if(!identical(c(TRUE,FALSE),get.edge.attribute(net,'na',na.omit=FALSE))){ stop("get.edge.attribute did not return correct values for 'na' attribute with na.omit=FALSE") } if(!identical(c(FALSE),get.edge.attribute(net,'na',na.omit=TRUE))){ stop("get.edge.attribute did not return correct values for 'na' attribute with na.omit=TRUE") } # check behavior on a network with no edges if(!identical(list(),get.edge.attribute(network.initialize(3),'foo',unlist=FALSE))){ stop("get.edge.attribute did not return correct values network with no edges") } if(!identical(NULL,get.edge.attribute(network.initialize(3),'foo',unlist=TRUE))){ stop("get.edge.attribute did not return correct values network with no edges") } if(!identical(NULL,get.edge.attribute(net,'bar'))){ stop("get.edge.attribute did not return correct values for attribute that does not exist") } # check for behavior of attribute values explicitly set to null net<-network.initialize(3) net[1,2]<-1 net[1,3]<-1 set.edge.attribute(net,'nullval',list(NULL)) # expect NULL,NULL if(!identical(list(NULL,NULL),get.edge.attribute(net,'nullval',unlist=FALSE,null.na=FALSE))){ stop("get.edge.attribute not returning NULL values stored as edge attribute correctly") } # expect that this should return NULL values, which will dissappear on unlisting # do NOT want to see NA,NA if(!identical(NULL,get.edge.attribute(net,'nullval',null.na=FALSE))){ stop("get.edge.attribute not returning NULL values stored as edge attribute correctly") } if(!identical(NULL,get.edge.attribute(net,'nullval',null.na=TRUE))){ stop("get.edge.attribute not returning NULL values stored as edge attribute correctly") } network/tests/speedTests.R0000644000176200001440000000416013357022000015344 0ustar liggesusers # some really basic speed checks to help us know if we make changes that massively degrade performance require(network) init<-system.time(net<-network.initialize(100000))[3] setv<-system.time(set.vertex.attribute(net,"foo","bar"))[3] getv<-system.time(get.vertex.attribute(net,"foo"))[3] listv<-system.time(list.vertex.attributes(net))[3] adde<-system.time(add.edges(net,tail=1:99999,head=2:100000))[3] sete<-system.time(set.edge.attribute(net,"foo","bar"))[3] gete<-system.time(get.edge.attribute(net,"foo"))[3] liste<-system.time(list.edge.attributes(net))[3] addmoree<-system.time(add.edge(net,100000,1))[3] addmorev<-system.time(add.vertices(net,1))[3] # optionally compare to benchmarks saved in test folder to see if things have changed # benchmarks<-rbind(init,setv,getv,listv,adde,sete,gete,liste,addmoree,addmorev) # oldmarks<-read.table(file.choose(),header=TRUE,colClasses=c('character','numeric')) # all.equal(oldmarks[,1],benchmarks[,1],check.attributes=FALSE) # optionally save out benchmarks to test directory # write.table(benchmarks,file=file.choose()) # some absolute thresholds if(init>5){ stop("initializing network for large number of vertices took much longer than expected") } if(setv>5){ stop("set.vertex.attribute for large number of vertices took much longer than expected") } if(getv>5){ stop("get.vertex.attribute for large number of vertices took much longer than expected") } if(listv>1){ stop("list.vertex.attributes for large number of vertices took much longer than expected") } if(adde>5){ stop("add.edges for a large number of edges took much longer than expected") } if(sete>10){ stop("set.edge.attribute for a large number of edges took much longer than expected") } if(gete>1){ stop("get.edge.attribute for a large number of edges took much longer than expected") } if(liste>1){ stop("list.edge.attribute for a large number of edges took much longer than expected") } if(addmoree>5){ stop("add.edge for a network with a large number of edges took much longer than expected") } if(addmorev>5){ stop("add.vertices for a network with large number of vertices took longer than expected") } network/tests/network.battery.R0000644000176200001440000002401213737227152016402 0ustar liggesusers#The following battery of tests is intended to verify the functionality of #the network library library(network) #These functions are intended to mimic functionality from the sna package. #Said package is not required to use network, but was used in creating this #battery of tests. rgraph<-function(n){ m<-matrix(rbinom(n*n,1,0.5),n,n) diag(m)<-0 m } degree<-function(d,cmode = "freeman") { n <- dim(d)[1] diag(d) <- NA switch(cmode, indegree = apply(d, 2, sum, na.rm = TRUE), outdegree = apply(d, 1, sum, na.rm = TRUE), freeman = apply(d, 2, sum, na.rm = TRUE) + apply(d, 1, sum, na.rm = TRUE)) } #gctorture(TRUE) #Uncomment to perform a more intensive (SLOW) test # ---- Check assignment, deletion, and adjacency for dyadic graphs ---- check<-vector() temp<-network(matrix(0,5,5)) temp[1,2]<-1 #Add edge check[1]<-temp[1,2]==1 #Check adjacency check[2]<-get.network.attribute(temp,"mnext")==2 #Check count temp[1,2]<-1 #Should have no effect check[3]<-get.network.attribute(temp,"mnext")==2 #Check count temp[1,1]<-1 #Should have no effect check[4]<-temp[1,1]==0 #Shouldn't be present check[5]<-get.network.attribute(temp,"mnext")==2 #Check count temp[,2]<-1 #Should add 3 edges check[6]<-get.network.attribute(temp,"mnext")==5 #Check count check[7]<-all(temp[,2]==c(1,0,1,1,1)) #Verify row temp[3:4,3:4]<-1 #Should add 2 edges check[8]<-get.network.attribute(temp,"mnext")==7 #Check count temp[,]<-0 #Delete edges check[9]<-all(temp[,]==matrix(0,5,5)) #Verify that edges were removed temp[1:2,3:5]<-1 #Add new edges check[10]<-sum(temp[,])==6 #Check edge sum temp<-add.vertices(temp,3) #Add vertices check[11]<-network.size(temp)==8 check[12]<-sum(temp[,])==6 #Edges should still be there check[13]<-all(temp[,5]==c(1,1,0,0,0,0,0,0)) temp[8,]<-1 #Add edges to new vertex check[14]<-all(temp[8,]==c(1,1,1,1,1,1,1,0)) #Verify temp<-delete.vertices(temp,c(7,8)) #Remove vertices check[15]<-network.size(temp)==6 #Verify removal check[16]<-sum(temp[,])==6 #Check edge sum check[17]<-!any(c(7,8)%in%c(sapply(temp$mel,"[[","inl"),sapply(temp$mel,"[[","outl"))) #Make sure they're really gone! temp<-network(matrix(0,5,5),directed=FALSE,loops=TRUE) #Create undir graph check[18]<-is.directed(temp)==FALSE #Some simple gal tests check[19]<-has.loops(temp)==TRUE temp[1,]<-1 check[20]<-all(temp[,1]==temp[1,]) #Verify edges temp<-permute.vertexIDs(temp,5:1) #Permute check[21]<-all(temp[1,]==c(0,0,0,0,1)) #Verify permutation check[22]<-all(temp[,5]==rep(1,5)) check[23]<-all(get.neighborhood(temp,1)%in%c(5,1)) #Check neighborhoods check[24]<-all(sort(get.neighborhood(temp,5))==1:5) check[25]<-length(get.edges(temp,5))==5 #Check get.edges check[26]<-length(get.edges(temp,5,2))==1 g<-rgraph(10) temp<-network(g) check[27]<-all(g==temp[,]) #Yet more edge checkage check[28]<-all(g[3:1,-(4:3)]==temp[3:1,-(4:3)]) temp[,,,names.eval="newval"]<-matrix(1:100,10,10) #Edge value assignment check[29]<-all(as.sociomatrix(temp,"newval")==matrix(1:100,10,10)*g) check[30]<-all(apply(as.matrix.network.incidence(temp),1,sum)==(degree(g,cmode="indegree")-degree(g,cmode="outdegree"))) #Check incidence matrix check[31]<-all(dim(as.matrix.network.incidence(temp))==c(10,sum(g))) check[32]<-all(apply(as.matrix.network.incidence(temp,"newval"),1,sum)==(degree(matrix(1:100,10,10)*g,cmode="indegree")-degree(matrix(1:100,10,10)*g,cmode="outdegree"))) check[33]<-all(as.matrix.network.edgelist(temp,"newval")==cbind(row(g)[g>0],col(g)[g>0],matrix(1:100,10,10)[g>0])) temp[1:3,1:5,names.eval="newval"]<-matrix(1:15,3,5) check[34]<-all(as.sociomatrix(temp,"newval")[1:3,1:5]==g[1:3,1:5]*matrix(1:15,3,5)) temp[,,"na"]<-TRUE #Verify NA filtering check[35]<-sum(temp[,,na.omit=TRUE])==0 check[36]<-sum(is.na(temp[,,na.omit=FALSE]))==sum(g) #---- Check assignment, deletion, and adjacency for hypergraphs ---- temp<-network.initialize(10,directed=F,hyper=T,loops=T) check[37]<-sum(temp[,])==0 temp<-add.edge(temp,1:4,1:4,"value",list(5)) temp<-add.edge(temp,3:5,3:5,"value",list(6)) temp<-add.edge(temp,4:7,4:7,"value",list(7)) temp<-add.edge(temp,6:10,6:10,"value",list(8)) check[38]<-all(as.matrix.network.incidence(temp)==cbind(c(1,1,1,1,0,0,0,0,0,0),c(0,0,1,1,1,0,0,0,0,0),c(0,0,0,1,1,1,1,0,0,0),c(0,0,0,0,0,1,1,1,1,1))) check[39]<-all(as.matrix.network.incidence(temp,"value")==cbind(5*c(1,1,1,1,0,0,0,0,0,0),6*c(0,0,1,1,1,0,0,0,0,0),7*c(0,0,0,1,1,1,1,0,0,0),8*c(0,0,0,0,0,1,1,1,1,1))) check[40]<-all(temp[,]==((as.matrix.network.incidence(temp)%*%t(as.matrix.network.incidence(temp)))>0)) #---- Check coercion and construction methods ---- g<-rgraph(10) temp<-network(g) check[41]<-all(temp[,]==g) temp<-as.network(g*matrix(1:100,10,10),names.eval="value",ignore.eval=FALSE) check[42]<-all(as.sociomatrix(temp,"value")==g*matrix(1:100,10,10)) temp<-as.network.matrix(as.matrix.network.edgelist(temp,"value"),matrix.type="edgelist",names.eval="value",ignore.eval=FALSE) check[43]<-all(as.sociomatrix(temp,"value")==g*matrix(1:100,10,10)) temp<-as.network.matrix(as.matrix.network.incidence(temp,"value"),matrix.type="incidence",names.eval="value",ignore.eval=FALSE) check[44]<-all(as.sociomatrix(temp,"value")==g*matrix(1:100,10,10)) # check functioning of na.rm argument #922 plain<-as.network.matrix(matrix(c(0,1,NA,NA),ncol=2),na.rm=TRUE) if (network.naedgecount(plain) != 0){ stop('problem with na values in adjacency matrix coericon') } plain<-as.network.matrix(matrix(c(0,1,NA,NA),ncol=2),na.rm=FALSE) if (network.naedgecount(plain) != 1){ stop('problem with na values in adjacnecy matrix coericon') } # test for as.matrix.network edgelist bug #935 x <- network.initialize(10) add.edge(x,1,2) add.edge(x,2,3) set.edge.attribute(x,'foo','bar',e=2) # i.e. the edge from 2 to 3 if (!identical(as.matrix.network.edgelist(x,'foo'),structure(c("1", "2", "2", "3", NA, "bar"), .Dim = 2:3, n = 10, vnames = 1:10))){ stop("problem with as.matrix.network.edgelist with attribute and deleted edge") } #---- Check attribute assignment/access ---- g<-rgraph(10) temp<-network(g) temp<-set.vertex.attribute(temp,"value",1:10) check[45]<-all(get.vertex.attribute(temp,"value")==1:10) temp<-delete.vertex.attribute(temp,"value") check[46]<-all(is.na(get.vertex.attribute(temp,"value"))) temp<-set.vertex.attribute(temp,"value",1:5,c(2,4,6,8,10)) check[47]<-all(get.vertex.attribute(temp,"value")[c(2,4,6,8,10)]==1:5) temp<-set.network.attribute(temp,"value","pork!") check[48]<-get.network.attribute(temp,"value")=="pork!" temp<-delete.network.attribute(temp,"value") check[49]<-is.null(get.network.attribute(temp,"value")) temp<-set.edge.attribute(temp,"value",5) check[50]<-all(get.edge.attribute(temp$mel,"value")==5) temp<-delete.edge.attribute(temp,"value") check[51]<-all(is.null(get.edge.attribute(temp$mel,"value"))) temp<-set.edge.value(temp,"value",g*matrix(1:100,10,10)) check[52]<-all(get.edge.value(temp,"value")==(g*matrix(1:100,10,10))[g>0]) check[53]<-all(as.sociomatrix(temp,"value")==(g*matrix(1:100,10,10))) #---- Check additional operators ---- g<-rgraph(10) temp<-network(g,names.eval="value",ignore.eval=FALSE) temp2<-network(g*2,names.eval="value",ignore.eval=FALSE) check[54]<-all(g==as.sociomatrix(temp+temp2)) check[55]<-all(g*3==as.sociomatrix(sum(temp,temp2,attrname="value"),"value")) check[56]<-all(g==as.sociomatrix(temp*temp2)) check[57]<-all(g*2==as.sociomatrix(prod(temp,temp2,attrname="value"),"value")) check[58]<-all(0==as.sociomatrix(temp-temp2)) check[59]<-all(-g==as.sociomatrix(sum(temp,-as.sociomatrix(temp2,"value"),attrname="value"),"value")) check[60]<-all(((g%*%g)>0)==as.sociomatrix("%c%.network"(temp,temp2))) check[61]<-all(((g%*%g)>0)==as.sociomatrix(temp%c%temp2)) check[62]<-all(((!temp)[,]==!g)[diag(10)<1]) check[63]<-all((temp|temp2)[,]==g) check[64]<-all((temp&temp2)[,]==g) temp%v%"value"<-1:10 check[65]<-all(temp%v%"value"==1:10) temp%n%"value"<-"pork!" check[66]<-temp%n%"value"=="pork!" # ---- Check to ensure that in-place modification is not producing side effects ---- g<-network.initialize(5); checkg<-g; add.vertices(g,3) check[67]<-(network.size(checkg)==5)&&(network.size(g)==8) g<-network.initialize(5); checkg<-g; delete.vertices(g,2) check[68]<-(network.size(checkg)==5)&&(network.size(g)==4) g<-network.initialize(5); checkg<-g; add.edge(g,2,3) check[69]<-(sum(checkg[,])==0)&&(sum(g[,])==1) g<-network.initialize(5); checkg<-g; add.edges(g,c(2,2,2),c(1,3,4)) check[70]<-(sum(checkg[,])==0)&&(sum(g[,])==3) g<-network.initialize(5); checkg<-g; g%v%"boo"<-1:5 check[71]<-all(is.na(checkg%v%"boo"))&&all(g%v%"boo"==1:5) g<-network.initialize(5); checkg<-g; g%n%"boo"<-1:5 check[72]<-is.null(checkg%n%"boo")&&all(g%n%"boo"==1:5) g<-network.initialize(5); g[1,]<-1; checkg<-g; g%e%"boo"<-col(matrix(0,5,5)) check[73]<-is.null(checkg%e%"boo")&&all(g%e%"boo"==2:5) g<-network.initialize(5); checkg<-g; permute.vertexIDs(g,5:1) check[74]<-all(checkg%v%"vertex.names"==1:5)&&all(g%v%"vertex.names"==5:1) g<-network.initialize(5); temp<-(function(){add.vertices(g,3); network.size(g)})() check[75]<-(network.size(g)==5)&&(temp==8) g<-network.initialize(5); (function(){g<-network.initialize(4); add.vertices(g,3)})() check[76]<-(network.size(g)==5) # check for operators with undirected edge error ticket #279 # nw1 is assigned tailhead nw2<-network.initialize(3,directed=FALSE) nw2[2,1]<-1 # Which, the binary network operators don't take into account: check[77]<-network.edgecount(nw1-nw2)==0 # Should have 0, has 1. check[78]<-network.edgecount(nw1|nw2)==1 # Should have 1, has 2 (1->2 and 2->1). check[79]<-network.edgecount(nw1&nw2)==1 # Should have 1, has 0 (since it treats 1->2 and 2->1 differently). check[80]<-network.edgecount(!nw1)==2 # Should have choose(3,2)-1=2, has 3. check[81]<-network.edgecount(!nw2)==2 # Should have choose(3,2)-1=2, has 2. #If everything worked, check is TRUE if(!all(check)){ #Should be TRUE stop(paste("network package test failed on test(s):",which(!check))) } network/tests/plotflo.R0000644000176200001440000000230313357022000014675 0ustar liggesusers# # load the library # library(network) # # attach the sociomatrix for the Florentine marriage data # This is not yet a graph object. # data(flo) # # print out the sociomatrix for the Florentine marriage data # flo # # Create a network object out of the adjacency matrix and print it out # nflo <- network(flo,directed=FALSE) nflo # # print out the sociomatrix for the Florentine marriage data # print(nflo,matrix.type="adjacency") # # plot the Florentine marriage data # plot(nflo) # # create a vector indicating the Medici family and add it as a covariate to the # graph object. # nflo <- set.vertex.attribute(nflo,"medici",c(0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0)) nflo # # create a vector indicating the Medici family for the graph # medici <- rep("",nrow(flo)) names(medici) <- dimnames(flo)[[1]] medici[names(medici)=="Medici"] <- "Medici" # # plot the marriage data, highlighting the Medici family # plot(nflo,vertex.col=1+get.vertex.attribute(nflo,"medici")) # plot the emon St. Helens network, with edge widths proportional # to 'Frequency', and edges labeled by their id data(emon) par(mar=c(0,0,0,0)) plot(emon[[5]],edge.label=TRUE,edge.label.cex=0.6, edge.col='gray',edge.lwd=(emon[[5]]%e%'Frequency')*2) network/tests/general.tests2.R0000644000176200001440000000637013434677341016112 0ustar liggesusers# additional tests of misc network functionality split off from general.tests.R to avoid speed warnings library(network) # ----- check memory saftey with a big assignment --- net<-network.initialize(100000) net<-add.edges(net,1:99999,2:100000) set.edge.attribute(net,'LETTERS',LETTERS) # --- tests for get.induced.subgraph additions -- data(emon) # extract the network of responders in MtStHelens network with interaction Frequency of 4 subG4<-get.inducedSubgraph(emon$MtStHelens,eid=which(emon$MtStHelens%e%'Frequency'==4)) if(network.size(subG4)!=24){ stop('wrong size eid induced subgraph') } if (any(subG4%e%'Frequency'!=4)){ stop('bad edges in eid induced subgraph') } # checks for error conditions # can't specify eid with v or alter # get.inducedSubgraph(v=1:2,emon$MtStHelens,eid=which(emon$MtStHelens%e%'Frequency'==4)) # get.inducedSubgraph(alter=1:2,emon$MtStHelens,eid=which(emon$MtStHelens%e%'Frequency'==4)) # get.inducedSubgraph(emon$MtStHelens,eid=200:300) # ---- tests for specific bugs/edgecases ----- # ticket #180 (used to throw error if no edges exist) set.edge.attribute(network.initialize(3),"test","a") # check for network of zero size --used to give error ticket #255 set.vertex.attribute(network.initialize(0),'foo','bar') # check for is.na.network problems #619 x2<-network.initialize(3) x2[1,2]<-NA if(is.na.network(x2)[1,2]!=1){ stop('problem iwth is.na.netowrk') } # check for na problems in which.matrix.type #926 mat <- matrix(rbinom(200, 1, 0.2), nrow = 20) naIndices <- sample(1:200, 20) mat[naIndices] <- NA nw <- network(mat) # ---- check for undirected loops getID cases #327 #609 ----- net<-network.initialize(2,loops=TRUE,directed=FALSE) net[1,1]<-1 net[1,2]<-1 net[2,2]<-1 if(get.edgeIDs(net,v=1,alter=1)!=1){ stop("problem with get.edgeIDs on undirected network with loops") } if(get.edgeIDs(net,v=2,alter=2)!=3){ stop("problem with get.edgeIDs on undirected network with loops") } net<-network.initialize(2,loops=TRUE,directed=FALSE) net[1,2]<-1 if(length(get.edgeIDs(net,v=2,alter=2))>0){ stop("problem with get.edgeIDs on undirected network with loops") } # check for problem with as.network.edgelist with zero edges #1138 result1 <- as.matrix.network.edgelist(network.initialize(5),as.sna.edgelist = TRUE) if (nrow(result1) != 0){ stop('as.matrix.network.edgelist did not return correct value for net with zero edges') } result1a <- tibble::as_tibble(network.initialize(5)) if (nrow(result1a) != 0){ stop('as_tibble.network did not return correct value for net with zero edges') } result2<-as.matrix.network.adjacency(network.initialize(5)) if(nrow(result2) != 5 & ncol(result2) != 5){ stop('as.matrix.network.adjacency did not return matrix with correct dimensions') } result3<-as.matrix.network.adjacency(network.initialize(0)) if(nrow(result3) != 0 & ncol(result3) != 0){ stop('as.matrix.network.adjacency did not return matrix with correct dimensions') } result4<-as.matrix.network.incidence(network.initialize(5)) if(nrow(result4) != 5 & ncol(result4) != 0){ stop('as.matrix.network.incidence did not return matrix with correct dimensions') } result5<-as.matrix.network.incidence(network.initialize(0)) if(nrow(result5) != 0 & ncol(result5) != 0){ stop('as.matrix.network.incidence did not return matrix with correct dimensions') } network/tests/testthat.R0000644000176200001440000000007213737227152015100 0ustar liggesuserslibrary(testthat) library(network) test_check("network") network/tests/vignette.R0000644000176200001440000001045013357022000015045 0ustar liggesusersrequire("network") set.seed(1702) results = NULL data("flo") data("emon") net <- network.initialize(5) net nmat <- matrix(rbinom(25, 1, 0.5), nr = 5, nc = 5) net <- network(nmat, loops = TRUE) net summary(net) results[1] = all(nmat == net[,]) net <- as.network(nmat, loops = TRUE) results[2] = all(nmat == net[,]) nflo <- network(flo, directed = FALSE) nflo results[3] = all(nflo[9,] == c(1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1)) results[4] = nflo[9,1] == 1 results[5] = nflo[9,4] == 0 results[6] = is.adjacent(nflo, 9, 1) == TRUE results[7] = is.adjacent(nflo, 9, 4) == FALSE results[8] = network.size(nflo) == 16 results[9] = network.edgecount(nflo) == 20 results[10] = network.density(nflo) == 1/6 results[11] = has.loops(nflo) == FALSE results[12] = is.bipartite(nflo) == FALSE results[13] = is.directed(nflo) == FALSE results[14] = is.hyper(nflo) == FALSE results[15] = is.multiplex(nflo) == FALSE as.sociomatrix(nflo) results[16] = all(nflo[,] == as.sociomatrix(nflo)) results[17] = all(as.matrix(nflo) == as.sociomatrix(nflo)) as.matrix(nflo,matrix.type = "edgelist") net <- network.initialize(5, loops = TRUE) net[nmat>0] <- 1 results[18] = all(nmat == net[,]) net[,] <- 0 net[,] <- nmat results[19] = all(nmat == net[,]) net[,] <- 0 for(i in 1:5) for(j in 1:5) if(nmat[i,j]) net[i,j] <- 1 results[20] = all(nmat == net[,]) net[,] <- 0 add.edges(net, row(nmat)[nmat>0], col(nmat)[nmat>0]) results[21] = all(nmat == net[,]) net[,] <- as.numeric(nmat[,]) results[22] = all(nmat == net[,]) net <- network.initialize(5) add.edge(net, 2, 3) net[,] results[23] = net[2,3] == 1 add.edges(net, c(3, 5), c(4, 4)) net[,] results[24] = (net[3,4] == 1 && net[5,4] == 1) net[,2] <- 1 net[,] results[25] = net[2,2] == 0 delete.vertices(net, 4) results[26] = all(net[,] == matrix(c(0,1,0,0,0,0,1,0,0,1,0,0,0,1,0,0), byrow=T, nrow=4)) add.vertices(net, 2) net[,] get.edges(net, 1) get.edges(net, 2, neighborhood = "in") get.edges(net, 1, alter = 2) results[27] = get.edgeIDs(net, 1) == 4 results[28] = all(get.edgeIDs(net, 2, neighborhood = "in") == c(7, 5, 4)) results[29] = get.edgeIDs(net, 1, alter = 2) == 4 results[30] = get.neighborhood(net, 1) == 2 results[31] = all(get.neighborhood(net, 2, type = "in") == c(4, 3, 1)) net[2,3] <- 0 results[32] = net[2,3] == 0 delete.edges(net, get.edgeIDs(net, 2, neighborhood = "in")) results[33] = all(net[,] == matrix(0, 6,6)) net <- network.initialize(5) set.network.attribute(net, "boo", 1:10) net %n% "hoo" <- letters[1:7] results[34] = 'boo' %in% list.network.attributes(net) results[35] = 'hoo' %in% list.network.attributes(net) results[36] = all(get.network.attribute(net, "boo") == c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)) results[37] = all(net %n% "hoo" == c("a", "b", "c", "d", "e", "f", "g")) delete.network.attribute(net, "boo") results[38] = 'boo' %in% list.network.attributes(net) == FALSE set.vertex.attribute(net, "boo", 1:5) net %v% "hoo" <- letters[1:5] results[39] = 'boo' %in% list.vertex.attributes(net) results[40] = 'hoo' %in% list.vertex.attributes(net) results[41] = all(get.vertex.attribute(net, "boo") == 1:5) results[42] = all(net %v% "hoo" == letters[1:5]) delete.vertex.attribute(net, "boo") results[43] = 'boo' %in% list.vertex.attributes(net) == FALSE net <- network(nmat) set.edge.attribute(net, "boo", sum(nmat):1) set.edge.value(net, "hoo", matrix(1:25, 5, 5)) net %e% "woo" <- matrix(rnorm(25), 5, 5) net[,, names.eval = "zoo"] <- nmat * 6 results[44] = 'boo' %in% list.edge.attributes(net) results[45] = 'hoo' %in% list.edge.attributes(net) results[46] = all(get.edge.attribute(get.edges(net, 1), "boo") == c(3,7)) results[47] = all(get.edge.value(net, "hoo") == c(2, 3, 11, 14, 17, 18, 21)) net %e% "woo" as.sociomatrix(net, "zoo") delete.edge.attribute(net, "boo") results[48] = 'boo' %in% list.edge.attributes(net) == FALSE MtSHloc <- emon$MtStHelens %v% "Location" MtSHimat <- cbind(MtSHloc %in% c("L", "B"), MtSHloc %in% c("NL", "B")) MtSHbyloc <- network(MtSHimat, matrix = "incidence", hyper = TRUE, directed = FALSE, loops = TRUE) MtSHbyloc %v% "vertex.names" <- emon$MtStHelens %v% "vertex.names" MtSHbyloc plot(nflo, displaylabels = TRUE, boxed.labels = FALSE) plot(nflo, displaylabels = TRUE, mode = "circle") plot(emon$MtSi) if (!all(results)) { stop(paste('The following tests in vignette.R failed:', which(results==FALSE))) } network/src/0000755000176200001440000000000014061532364012536 5ustar liggesusersnetwork/src/layout.h0000644000176200001440000000262013650470751014230 0ustar liggesusers/* ###################################################################### # # layout.h # # Written by Carter T. Butts # Last Modified 9/6/10 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains headers for layout.c. # ###################################################################### */ #ifndef LAYOUT_H #define LAYOUT_H /*DECLARATIONS/INCLUSIONS---------------------------------------------------*/ #include #include #include #include #include #include "utils.h" /*Simple list structures to be used for temporary storage of vertex sets.*/ typedef struct vlisttype{ long int v; struct vlisttype *next; } vlist; typedef struct vcelltype{ int id; double count,xm,ym; struct vlisttype *memb; struct vcelltype *next; } vcell; /*R-CALLABLE ROUTINES-------------------------------------------------------*/ void network_layout_fruchtermanreingold_R(double *d, double *pn, double *pm, int *pniter, double *pmaxdelta, double *pvolume, double *pcoolexp, double *prepulserad, int *pncell, double *pcjit, double *pcppr, double *pcpcr, double *pcccr, double *x, double *y); void network_layout_kamadakawai_R(int *d, double *pn, int *pniter, double *elen, double *pinitemp, double *pcoolexp, double *pkkconst, double *psigma, double *x, double *y); #endif network/src/utils.c0000644000176200001440000005711713650470733014061 0ustar liggesusers/* ###################################################################### # # utils.c # # Written by Carter T. Butts # Last Modified 03/04/19 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains basic utility routines. # ###################################################################### */ #include #include #include #include #include #include #include #include #include "utils.h" /*LIST ACCESS/MODIFICATION ROUTINES-----------------------------------------*/ SEXP deleteListElement(SEXP list, const char *str) /*Given a list and a character string, return a new list with the element whose name matches said string removed. If this is the only element of list, NULL is returned; if the element is not found, list is returned unmodified.*/ { int pc=0,i,flag; SEXP newlist, names, newnames; /*If this is obviously pointless, return the original pointer*/ if(length(list)==0) return list; /*Evidently, we should try searching for the element...*/ PROTECT(names=getAttrib(list, R_NamesSymbol)); pc++; PROTECT(newlist=allocVector(VECSXP,length(list)-1)); pc++; PROTECT(newnames=allocVector(STRSXP,length(list)-1)); pc++; flag=0; for(i=0;(i0){ switch(TYPEOF(list)){ case VECSXP: PROTECT(newlist = allocVector(VECSXP, length(list)+n)); pc++; PROTECT(newnames = allocVector(STRSXP, length(list)+n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; case STRSXP: PROTECT(newlist = allocVector(STRSXP, length(list)+n)); pc++; PROTECT(newnames = allocVector(STRSXP, length(list)+n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; case INTSXP: PROTECT(newlist = allocVector(INTSXP, length(list)+n)); pc++; PROTECT(newnames = allocVector(STRSXP, length(list)+n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; case REALSXP: PROTECT(newlist = allocVector(REALSXP, length(list)+n)); pc++; PROTECT(newnames = allocVector(STRSXP, length(list)+n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; case RAWSXP: PROTECT(newlist = allocVector(RAWSXP, length(list)+n)); pc++; PROTECT(newnames = allocVector(STRSXP, length(list)+n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; case LGLSXP: PROTECT(newlist = allocVector(LGLSXP, length(list)+n)); pc++; PROTECT(newnames = allocVector(STRSXP, length(list)+n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; default: error("unimplemented type in enlargeList\n"); } UNPROTECT(pc); return newlist; }else{ return list; } } SEXP contractList(SEXP list, int n) /*Return a pointer to a contracted version of list, where only the first n items are selected. If n>=length(list), then list is returned.*/ { int i,pc=0; SEXP newlist=R_NilValue, names, newnames; /*Rprintf("\t\tcontractList entered, changing length from %d to %d\n",length(list),n);*/ if(ni) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; case STRSXP: PROTECT(newlist = allocVector(STRSXP, n)); pc++; PROTECT(newnames = allocVector(STRSXP, n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; case INTSXP: PROTECT(newlist = allocVector(INTSXP, n)); pc++; PROTECT(newnames = allocVector(STRSXP, n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; case LGLSXP: PROTECT(newlist = allocVector(LGLSXP, n)); pc++; PROTECT(newnames = allocVector(STRSXP, n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; case REALSXP: PROTECT(newlist = allocVector(REALSXP, n)); pc++; PROTECT(newnames = allocVector(STRSXP, n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; case RAWSXP: PROTECT(newlist = allocVector(RAWSXP, n)); pc++; PROTECT(newnames = allocVector(STRSXP, n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; default: error("unimplemented type in contractList\n"); } UNPROTECT(pc); return newlist; }else{ return list; } } SEXP concatList(int nel, int names, ...) /*This is a highly experimental function to build a list object by concatenating the specified arguments. nel must give the number of list elements included, and names=1 iff names are supplied. In the latter case, these must be strings, and must be given as arguments in order following the list elements.*/ { int i,pc=0; SEXP list,lnam; va_list ap; error("concatList doesn't work yet! Sorry....\n"); /*Rprintf("\t\tEntered concatList w/%d arguments; names=%d\n",nel,names);*/ va_start(ap, names); /*Initialize the argument list*/ PROTECT(list = allocVector(VECSXP,nel)); pc++; /*Allocate list memory*/ for(i=0;i0)) Rprintf("\t\t\tFirst element of a=%d\n",INTEGER(a)[0]); if(IS_INTEGER(b)&&(length(b)>0)) Rprintf("\t\t\tFirst element of b=%d\n",INTEGER(b)[0]);*/ PROTECT(merged=vecAppend(a,b)); /*Rprintf("\t\tAppended list is length %d\n",length(merged)); if(IS_INTEGER(merged)&&(length(merged)>0)) Rprintf("\t\t\tFirst list element=%d\n",INTEGER(merged)[0]);*/ PROTECT(merged=vecUnique(merged)); UNPROTECT(2); return merged; } SEXP vecUnique(SEXP a) { int pc=0,*dup,dcount=0,i,j; SEXP newv=R_NilValue; /*Proceed by type*/ switch(TYPEOF(a)){ case INTSXP: /*Identify duplicates*/ dup=(int *)R_alloc(length(a),sizeof(int)); for(i=0;i # Last Modified 03/04/19 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains routines related to constructor methods for # network objects. # ###################################################################### */ #include #include #include #include #include #include "utils.h" #include "constructors.h" /*INTERNAL ROUTINES----------------------------------------------------*/ /*R-CALLABLE ROUTINES--------------------------------------------------*/ SEXP copyEdges_R(SEXP x, SEXP y) /*Copy all edges from network x into network y. Note that y is assumed to have been initialized so as to have the same size as x.*/ { int pc=0; SEXP mel,mel2,iel,iel2,oel,oel2; mel=getListElement(x,"mel"); PROTECT(mel2=duplicate(mel)); pc++; PROTECT(y=setListElement(y,"mel",mel2)); pc++; iel=getListElement(x,"iel"); PROTECT(iel2=duplicate(iel)); pc++; PROTECT(y=setListElement(y,"iel",iel2)); pc++; oel=getListElement(x,"oel"); PROTECT(oel2=duplicate(oel)); pc++; y=setListElement(y,"oel",oel2); UNPROTECT(pc); return y; } SEXP copyNetwork_R(SEXP x) { int pc=0; SEXP y; PROTECT(y=duplicate(x)); pc++; UNPROTECT(pc); return y; } SEXP copyNetworkAttributes_R(SEXP x, SEXP y) /*Copy all network attributes from network x into network y.*/ { int pc=0; SEXP gal,gal2; gal=getListElement(x,"gal"); PROTECT(gal2=duplicate(gal)); pc++; y=setListElement(y,"gal",gal2); UNPROTECT(pc); return y; } SEXP copyVertexAttributes_R(SEXP x, SEXP y) /*Copy all vertex attributes from network x into network y. Note that y is assumed to have been initialized so as to have the same size as x.*/ { int pc=0; SEXP val,val2; val=getListElement(x,"val"); PROTECT(val2=duplicate(val)); pc++; y=setListElement(y,"val",val2); UNPROTECT(pc); return y; } network/src/access.h0000644000176200001440000000650013650471001014142 0ustar liggesusers/* ###################################################################### # # access.h # # Written by Carter T. Butts # Last Modified 7/07/16 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains headers for access.c. # ###################################################################### */ #ifndef ACCESS_H #define ACCESS_H /*DECLARATIONS/INCLUSIONS---------------------------------------------------*/ #include #include #include #include #include #include #include #include /*INTERNAL ROUTINES---------------------------------------------------------*/ SEXP deleteEdgeAttribute(SEXP x, int e, const char *attrname); SEXP deleteNetworkAttribute(SEXP x, const char *attrname); SEXP deleteVertexAttribute(SEXP x, int v, const char *attrname); SEXP getEdgeAttribute(SEXP x, int e, const char *str); SEXP getEdgeIDs(SEXP x, int v, int alter, const char *neighborhood, int naOmit); SEXP getEdges(SEXP x, int v, int alter, const char *neighborhood, int naOmit); SEXP getNeighborhood(SEXP x, int v, const char *type, int naOmit); SEXP getNetworkAttribute(SEXP x, const char *str); int hasLoops(SEXP x); int isAdjacent(SEXP x, int vi, int vj, int naOmit); int isDirected(SEXP x); int isHyper(SEXP x); int isLoop(SEXP outl, SEXP inl); int isMultiplex(SEXP x); int isNetwork(SEXP x); int networkEdgecount(SEXP x, int naOmit); int networkSize(SEXP x); SEXP setNetworkAttribute(SEXP x, const char *attrname, SEXP value); SEXP setVertexAttribute(SEXP x, const char *attrname, SEXP value, int v); SEXP deleteEdges(SEXP x, SEXP eid); SEXP permuteVertexIDs(SEXP x, SEXP vids); SEXP addEdges(SEXP x, SEXP tail, SEXP head, SEXP namesEval, SEXP valsEval, SEXP edgeCheck); /*R-CALLABLE ROUTINES-------------------------------------------------------*/ SEXP addEdge_R(SEXP x, SEXP tail, SEXP head, SEXP namesEval, SEXP valsEval, SEXP edgeCheck); SEXP addEdges_R(SEXP x, SEXP tail, SEXP head, SEXP namesEval, SEXP valsEval, SEXP edgeCheck); SEXP addVertices_R(SEXP x, SEXP nv, SEXP vattr); SEXP deleteEdgeAttribute_R(SEXP x, SEXP attrname); SEXP getEdgeAttribute_R(SEXP el,SEXP attrname, SEXP naomit,SEXP nullna,SEXP deletededgesomit); SEXP deleteEdges_R(SEXP x, SEXP eid); SEXP deleteNetworkAttribute_R(SEXP x, SEXP attrname); SEXP deleteVertexAttribute_R(SEXP x, SEXP attrname); SEXP deleteVertices_R(SEXP x, SEXP vid); SEXP getEdgeIDs_R(SEXP x, SEXP v, SEXP alter, SEXP neighborhood, SEXP naOmit); SEXP getEdges_R(SEXP x, SEXP v, SEXP alter, SEXP neighborhood, SEXP naOmit); SEXP getNeighborhood_R(SEXP x, SEXP v, SEXP type, SEXP naOmit); SEXP isAdjacent_R(SEXP x, SEXP vi, SEXP vj, SEXP naOmit); SEXP isNANetwork_R(SEXP x, SEXP y); SEXP networkEdgecount_R(SEXP x, SEXP naOmit); SEXP permuteVertexIDs_R(SEXP x, SEXP vids); SEXP setEdgeAttribute_R(SEXP x, SEXP attrname, SEXP value, SEXP e); SEXP setEdgeAttributes_R(SEXP x, SEXP attrname, SEXP value, SEXP e); SEXP setEdgeValue_R(SEXP x, SEXP attrname, SEXP value, SEXP e); SEXP setNetworkAttribute_R(SEXP x, SEXP attrname, SEXP value); SEXP setVertexAttribute_R(SEXP x, SEXP attrname, SEXP value, SEXP v); SEXP setVertexAttributes_R(SEXP x, SEXP attrname, SEXP value, SEXP v); SEXP nonEmptyEdges_R(SEXP el); #endif network/src/utils.h0000644000176200001440000000307313650470724014056 0ustar liggesusers/* ###################################################################### # # utils.h # # Written by Carter T. Butts # Last Modified 08/20/13 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains headers for utils.c. # ###################################################################### */ #ifndef UTILS_H #define UTILS_H /*DECLARATIONS/INCLUSIONS---------------------------------------------------*/ #include #include #include #include #include #include #include #include #include #define MIN(a,b) ((a)<(b) ? (a) : (b)) #define MAX(a,b) ((a)<(b) ? (b) : (a)) /*LIST ACCESS/MODIFICATION ROUTINES-----------------------------------------*/ SEXP deleteListElement(SEXP list, const char *str); SEXP getListElement(SEXP list, const char *str); SEXP setListElement(SEXP list, const char *str, SEXP elem); SEXP enlargeList(SEXP list, int n); SEXP contractList(SEXP list, int n); SEXP concatList(int nel, int names, ...); SEXP permuteList(SEXP list, SEXP ord); /*VECTOR COMPARISON/TEST ROUTINES-------------------------------------------*/ int vecAnyNA(SEXP a); int vecEq(SEXP a, SEXP b); int vecIsIn(double a, SEXP b); double vecMax(SEXP a); double vecMin(SEXP a); /*VECTOR MODIFICATION ROUTINES----------------------------------------------*/ SEXP vecAppend(SEXP a, SEXP b); SEXP vecRemove(SEXP v, double e); SEXP vecUnion(SEXP a, SEXP b); SEXP vecUnique(SEXP a); #endif network/src/layout.c0000644000176200001440000002273213650470755014235 0ustar liggesusers/* ###################################################################### # # layout.c # # Written by Carter T. Butts # Last Modified 9/6/10 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains routines related to computation of vertex layouts # for plot.network (i.e., the plot.network.layout.* functions). Note that # this was originally ported directly from the sna package (also by Carter # Butts), although some bits may have evolved. # ###################################################################### */ #include #include #include #include #include "layout.h" /*TWO-DIMENSIONAL LAYOUT ROUTINES--------------------------------------*/ void network_layout_fruchtermanreingold_R(double *d, double *pn, double *pm, int *pniter, double *pmaxdelta, double *pvolume, double *pcoolexp, double *prepulserad, int *pncell, double *pcjit, double *pcppr, double *pcpcr, double *pcccr, double *x, double *y) /* Calculate a two-dimensional Fruchterman-Reingold layout for (symmetrized) edgelist matrix d (2 column). Positions (stored in (x,y)) should be initialized prior to calling this routine. */ { double frk,maxdelta,volume,coolexp,repulserad,t,ded,xd,yd,*dx,*dy; double rf,af,xmax,xmin,ymax,ymin,xwid,ywid,cjit,cppr,cpcr,cccr,celldis; long int n,j,k,l,m; int niter,i,*cellid,ncell,ix,iy,jx,jy; char *vmax; vcell *vcells,*p,*p2; vlist *vlp,*vlp2; /*Define various things*/ n=(long int)*pn; if (n <= 1) return; /* quick return when too few nodes to layout */ m=(long int)*pm; niter=*pniter; maxdelta=*pmaxdelta; volume=*pvolume; coolexp=*pcoolexp; repulserad=*prepulserad; ncell=*pncell; cjit=*pcjit; cppr=*pcppr; cpcr=*pcpcr; cccr=*pcccr; frk=sqrt(volume/(double)n); /*Define the F-R constant*/ xmin=ymin=R_PosInf; xmax=ymax=R_NegInf; /*Allocate memory for transient structures*/ dx=(double *)R_alloc(n,sizeof(double)); dy=(double *)R_alloc(n,sizeof(double)); cellid=(int *)R_alloc(n,sizeof(int)); /*Run the annealing loop*/ for(i=niter;i>=0;i--){ /*Check for interrupts, before messing with temporary storage*/ R_CheckUserInterrupt(); /*Allocate cell structures for this iteration*/ GetRNGstate(); vmax=vmaxget(); xmin=ymin=R_PosInf; xmax=ymax=R_NegInf; for(j=0;jnext!=NULL)&&(p->id!=cellid[j]);p=p->next); if(p==NULL){ /*Head was null; initiate*/ vcells=p=(vcell *)R_alloc(1,sizeof(vcell)); p->id=cellid[j]; p->next=NULL; p->memb=NULL; p->count=0.0; p->xm=0.0; p->ym=0.0; }else if(p->id!=cellid[j]){ /*Got to end, insert new element*/ p->next=(vcell *)R_alloc(1,sizeof(vcell)); p=p->next; p->id=cellid[j]; p->next=NULL; p->memb=NULL; p->count=0.0; p->xm=0.0; p->ym=0.0; } /*Add j to the membership stack for this cell*/ p->count++; vlp=(vlist *)R_alloc(1,sizeof(vlist)); vlp->v=j; vlp->next=p->memb; p->memb=vlp; p->xm=((p->xm)*((p->count)-1.0)+x[j])/(p->count); p->ym=((p->ym)*((p->count)-1.0)+y[j])/(p->count); } PutRNGstate(); /*Set the temperature (maximum move/iteration)*/ t=maxdelta*pow(i/(double)niter,coolexp); /*Clear the deltas*/ for(j=0;jnext) /*Add forces at the cell level*/ for(p2=p;p2!=NULL;p2=p2->next){ /*Get cell identities*/ ix=(p->id)%ncell; jx=(p2->id)%ncell; iy=(int)floor((p->id)/ncell); jy=(int)floor((p2->id)/ncell); celldis=(double)((ix-jx)*(ix-jx)+(iy-jy)*(iy-jy)); /*Sq cell/cell dist*/ if(celldis<=cppr+0.001){ /*Use point/point calculations (exact)*/ for(vlp=p->memb;vlp!=NULL;vlp=vlp->next) for(vlp2=((p==p2)?(vlp->next):(p2->memb));vlp2!=NULL; vlp2=vlp2->next){ /*Obtain difference vector*/ xd=x[vlp->v]-x[vlp2->v]; yd=y[vlp->v]-y[vlp2->v]; ded=sqrt(xd*xd+yd*yd); /*Get dyadic euclidean distance*/ xd/=ded; /*Rescale differences to length 1*/ yd/=ded; /*Calculate repulsive "force"*/ rf=frk*frk*(1.0/ded-ded*ded/repulserad); dx[vlp->v]+=xd*rf; /*Add to the position change vector*/ dx[vlp2->v]-=xd*rf; dy[vlp->v]+=yd*rf; dy[vlp2->v]-=yd*rf; } }else if(celldis<=cpcr+0.001){ /*Use point/cell calculations (approx)*/ /*Add force increments to each member of p and p2*/ for(vlp=p->memb;vlp!=NULL;vlp=vlp->next){ xd=x[vlp->v]-(p2->xm); yd=y[vlp->v]-(p2->ym); ded=sqrt(xd*xd+yd*yd); /*Get dyadic euclidean distance*/ xd/=ded; /*Rescale differences to length 1*/ yd/=ded; /*Calculate repulsive "force"*/ rf=frk*frk*(1.0/ded-ded*ded/repulserad); /*Add to dx and dy*/ dx[vlp->v]+=xd*rf*(p2->count); dy[vlp->v]+=yd*rf*(p2->count); } for(vlp=p2->memb;vlp!=NULL;vlp=vlp->next){ xd=x[vlp->v]-(p->xm); yd=y[vlp->v]-(p->ym); ded=sqrt(xd*xd+yd*yd); /*Get dyadic euclidean distance*/ xd/=ded; /*Rescale differences to length 1*/ yd/=ded; /*Calculate repulsive "force"*/ rf=frk*frk*(1.0/ded-ded*ded/repulserad); /*Add to dx and dy*/ dx[vlp->v]+=xd*rf*(p->count); dy[vlp->v]+=yd*rf*(p->count); } }else if(celldis<=cccr+0.001){ /*Use cell/cell calculations (crude!)*/ xd=(p->xm)-(p2->xm); yd=(p->ym)-(p2->ym); ded=sqrt(xd*xd+yd*yd); /*Get dyadic euclidean distance*/ xd/=ded; /*Rescale differences to length 1*/ yd/=ded; /*Calculate repulsive "force"*/ rf=frk*frk*(1.0/ded-ded*ded/repulserad); /*Add force increment to each member of p and p2*/ for(vlp=p->memb;vlp!=NULL;vlp=vlp->next){ dx[vlp->v]+=xd*rf*(p2->count); dy[vlp->v]+=yd*rf*(p2->count); } for(vlp=p2->memb;vlp!=NULL;vlp=vlp->next){ dx[vlp->v]-=xd*rf*(p->count); dy[vlp->v]-=yd*rf*(p->count); } } } /*Calculate attraction along edges*/ for(j=0;jt){ /*Dampen to t*/ ded=t/ded; dx[j]*=ded; dy[j]*=ded; } x[j]+=dx[j]; /*Update positions*/ y[j]+=dy[j]; } /*Free memory for cell membership (or at least unprotect it)*/ vmaxset(vmax); } } void network_layout_kamadakawai_R(int *d, double *pn, int *pniter, double *elen, double *pinitemp, double *pcoolexp, double *pkkconst, double *psigma, double *x, double *y) { double initemp,coolexp,sigma,temp,candx,candy; double dpot,odis,ndis,osqd,nsqd,kkconst; int niter; long int n,i,j,k; /*Define various things*/ n=(long int)*pn; niter=*pniter; initemp=*pinitemp; coolexp=*pcoolexp; kkconst=*pkkconst; sigma=*psigma; GetRNGstate(); /*Get the RNG state*/ /*Perform the annealing loop*/ temp=initemp; for(i=0;i # Last Modified 4/7/06 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains headers for constructors.c. # ###################################################################### */ #ifndef CONSTRUCTORS_H #define CONSTRUCTORS_H /*DECLARATIONS/INCLUSIONS---------------------------------------------------*/ #include #include #include #include #include /*INTERNAL ROUTINES---------------------------------------------------------*/ /*R-CALLABLE ROUTINES-------------------------------------------------------*/ SEXP copyEdges_R(SEXP x, SEXP y); SEXP copyNetwork_R(SEXP x); SEXP copyNetworkAttributes_R(SEXP x, SEXP y); SEXP copyVertexAttributes_R(SEXP x, SEXP y); #endif network/src/access.c0000644000176200001440000017430213650471006014150 0ustar liggesusers/* ###################################################################### # # access.c # # Written by Carter T. Butts # Last Modified 03/04/19 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains routines related to access methods for network # objects. # ###################################################################### */ #include #include #include #include #include #include #include #include "utils.h" #include "access.h" /*INTERNAL ROUTINES----------------------------------------------------*/ SEXP deleteEdgeAttribute(SEXP x, int e, const char *attrname) /*Deletes the attribute named by attrname from edge with ID e.*/ { int pc=0; SEXP edge,atl; edge=VECTOR_ELT(getListElement(x,"mel"),e-1); PROTECT(atl=deleteListElement(getListElement(edge,"atl"),attrname)); pc++; edge=setListElement(edge,"atl",atl); UNPROTECT(pc); return x; } SEXP deleteNetworkAttribute(SEXP x, const char *attrname) /*Deletes the network attribute named by attrname.*/ { int pc=0; SEXP gal; PROTECT(gal=deleteListElement(getListElement(x,"gal"),attrname)); pc++; setListElement(x,"gal",gal); UNPROTECT(pc); return x; } SEXP deleteVertexAttribute(SEXP x, int v, const char *attrname) /*Deletes the attribute named by attrname from vertex with ID v.*/ { int pc=0; SEXP val,atts; val=getListElement(x,"val"); PROTECT(atts=deleteListElement(VECTOR_ELT(val,v-1),attrname)); pc++; SET_VECTOR_ELT(val,v-1,atts); UNPROTECT(pc); return x; } SEXP getEdgeAttribute(SEXP x, int e, const char *str) /*Returns a pointer to the attribute of edge e named by str, or else R_NilValue (if the edge and/or attribute is missing).*/ { SEXP el; /*Retrieve the edge, and sound a warning if not present.*/ el=VECTOR_ELT(getListElement(x,"mel"),e-1); if(el==R_NilValue){ warning("Attempt to get attribute %s for edge %e failed in getEdgeAttribute: no such edge.\n",str,e); return R_NilValue; } return getListElement(getListElement(el,"atl"),str); } SEXP getEdgeIDs(SEXP x, int v, int alter, const char *neighborhood, int naOmit) /*Retrieve the IDs of all edges incident on v, in network x. Outgoing or incoming edges are specified by neighborhood, while na.omit indicates whether or not missing edges should be omitted. If alter>0, only edges whose alternate endpoints contain alter are returned. The return value is a vector of edge IDs.*/ { SEXP eids,newids,mel,ilist,olist,eplist; int i,j,k,pc=0,ecount,*keep,dir; /* set ilist and olist to null to avoid compiler uninitialization warning in the cases that they are needed, code will set them */ ilist=NULL; olist=NULL; /*Enforce "combined" behavior unless x is directed*/ dir=isDirected(x); /*Rprintf("getEdgeIDs: v=%d, a=%d, neighborhood=%s\n",v,alter,neighborhood);*/ /*Begin by getting all edge IDs for the neighborhood in question*/ if(dir&&(strcmp(neighborhood,"out")==0)){ PROTECT(eids=coerceVector(VECTOR_ELT(getListElement(x,"oel"),v-1),INTSXP)); pc++; }else if(dir&&(strcmp(neighborhood,"in")==0)){ PROTECT(eids=coerceVector(VECTOR_ELT(getListElement(x,"iel"),v-1),INTSXP)); pc++; }else{ PROTECT(ilist=coerceVector(VECTOR_ELT(getListElement(x,"oel"),v-1), INTSXP)); pc++; PROTECT(olist=coerceVector(VECTOR_ELT(getListElement(x,"iel"),v-1), INTSXP)); pc++; /*Rprintf("\tAbout to enter union with list lengths %d and %d\n", length(ilist),length(olist));*/ PROTECT(eids=vecUnion(ilist,olist)); pc++; /*Rprintf("\t\tEscaped vecUnion, new list is length %d\n",length(eids));*/ /* PROTECT(eids=vecUnion(coerceVector(VECTOR_ELT(getListElement(x,"oel"),v-1), INTSXP), coerceVector(VECTOR_ELT(getListElement(x,"iel"),v-1),INTSXP))); pc++;*/ } /*Rprintf("\tIdentified %d candidate edges\n",length(eids)); if(length(eids)>0) Rprintf("\t\tFirst edge is ID %d\n",INTEGER(eids)[0]);*/ /*Remove any edges not containing alter (if given) and/or missing (if naOmit is TRUE).*/ ecount=0; keep=(int *)R_alloc(length(eids),sizeof(int)); mel=getListElement(x,"mel"); for(i=0;i0){ /*Remove edges not containing alter?*/ /*Get the relevant endpoints of the edge in question*/ if(dir&&(strcmp(neighborhood,"out")==0)){ PROTECT(eplist=coerceVector(getListElement(VECTOR_ELT(mel, INTEGER(eids)[i]-1),"inl"),INTSXP)); pc++; }else if(dir&&(strcmp(neighborhood,"in")==0)){ PROTECT(eplist=coerceVector(getListElement(VECTOR_ELT(mel, INTEGER(eids)[i]-1),"outl"),INTSXP)); pc++; }else{ PROTECT(ilist=coerceVector(getListElement(VECTOR_ELT(mel, INTEGER(eids)[i]-1),"inl"),INTSXP)); pc++; PROTECT(olist=coerceVector(getListElement(VECTOR_ELT(mel, INTEGER(eids)[i]-1),"outl"),INTSXP)); pc++; PROTECT(eplist=vecAppend(ilist,olist)); pc++; } /*Check to see if any endpoint matches alter*/ /*Rprintf("\t\tchecking endpoints of EID %d\n",INTEGER(eids)[i]);*/ keep[i]=0; if (dir | (v!=alter)){ /* does this still work in hypergraphic case?*/ for(j=0;(j0) Rprintf("\t\tFirst ID is %d\n",INTEGER(newids)[0]);*/ /*Unprotect and return*/ UNPROTECT(pc); return newids; } SEXP getEdges(SEXP x, int v, int alter, const char *neighborhood, int naOmit) /*Retrieve all edges incident on v, in network x. Outgoing or incoming edges are specified by neighborhood, while na.omit indicates whether or not missing edges should be omitted. If alter>0, only edges whose alternate endpoints contain alter are returned. The return value is a list of edges.*/ { SEXP eids,el,mel,eplist,aptr,bptr; int i,j,pc=0,ecount,*keep,dir; /*If x is undirected, enforce "combined" behavior*/ dir=isDirected(x); /*Rprintf("getEdges: v=%d, a=%d, neighborhood=%s\n",v,alter,neighborhood);*/ /*Begin by getting all edge IDs for the neighborhood in question*/ if(dir&&(strcmp(neighborhood,"out")==0)){ PROTECT(eids=coerceVector(VECTOR_ELT(getListElement(x,"oel"),v-1),INTSXP)); pc++; }else if(dir&&(strcmp(neighborhood,"in")==0)){ PROTECT(eids=coerceVector(VECTOR_ELT(getListElement(x,"iel"),v-1),INTSXP)); pc++; }else{ PROTECT(aptr=coerceVector(VECTOR_ELT(getListElement(x,"oel"),v-1), INTSXP)); pc++; PROTECT(bptr=coerceVector(VECTOR_ELT(getListElement(x,"iel"),v-1),INTSXP)); pc++; PROTECT(eids=vecUnion(aptr,bptr)); pc++; } /*Extract the edges associated with the eid list, removing any edges not containing alter (if given) and/or missing (if naOmit is TRUE).*/ ecount=0; keep=(int *)R_alloc(length(eids),sizeof(int)); mel=getListElement(x,"mel"); for(i=0;i0){ /*Remove edges not containing alter?*/ /*Get the relevant endpoints of the edge in question*/ if(dir&&(strcmp(neighborhood,"out")==0)){ PROTECT(eplist=coerceVector(getListElement(VECTOR_ELT(mel, INTEGER(eids)[i]-1),"inl"),INTSXP)); pc++; }else if(dir&&(strcmp(neighborhood,"in")==0)){ PROTECT(eplist=coerceVector(getListElement(VECTOR_ELT(mel, INTEGER(eids)[i]-1),"outl"),INTSXP)); pc++; }else{ PROTECT(aptr=coerceVector(getListElement(VECTOR_ELT(mel, INTEGER(eids)[i]-1),"inl"),INTSXP)); pc++; PROTECT(bptr=coerceVector(getListElement(VECTOR_ELT(mel, INTEGER(eids)[i]-1),"outl"),INTSXP)); pc++; PROTECT(eplist=vecAppend(aptr,bptr)); pc++; } /*Check to see if any endpoint matches alter*/ keep[i]=0; for(j=0;(j0, missing edges are discarded; otherwise, they are employed as well.*/ { int pc=0,i,dir; SEXP el,eps,val=R_NilValue; /*Check for directedness of x*/ dir=isDirected(x); /*Accumulate endpoints from the edge list*/ PROTECT(eps=allocVector(INTSXP,0)); pc++; if(dir&&(strcmp(type,"in")==0)){ /*In => get tail list*/ PROTECT(el = getEdges(x,v,0,"in",naOmit)); pc++; for(i=0;i get head list*/ PROTECT(el = getEdges(x,v,0,"out",naOmit)); pc++; for(i=0;i get both lists*/ if(!dir){ /*Annoying kludge to deal with getEdges loop issue, part 1*/ /*The issue here is that getEdges (reasonably?) enforces "combined" behavior for undirected graphs, returning any edge with v as an endpoint. This clashes with what we need to do here; as a workaround, we temporarily make x "directed" to change the behavior of getEdges (afterwards changing it back). This works fine, but involves two unneeded write operations for what should be a read-only function. As such, it should eventually be patched (probably by creating an option to force the behavior of getEdges).*/ PROTECT(val=allocVector(LGLSXP,1)); pc++; LOGICAL(val)[0]=1; x=setNetworkAttribute(x,"directed",val); /*Temporarily make directed*/ } PROTECT(el = getEdges(x,v,0,"in",naOmit)); pc++; for(i=0;i0, then missing edges are not counted; otherwise, all edges are included. (Note: this is the internal version.)*/ { int i,ecount=0,pc=0; SEXP mel,na; mel=getListElement(x,"mel"); if(naOmit){ /*Omit missing edges*/ for(i=0;i(double)networkSize(x)) ||(vecMax(outl)>(double)networkSize(x))) error("(edge check) Illegal vertex reference in addEdges_R. Exiting."); if(INTEGER(edgeCheck)[0]){ if(length(inl)*length(outl)==0) error("(edge check) Empty head/tail list in addEdges_R. Exiting."); if(!isHyper(x)) if(MAX(length(inl),length(outl))>1) error("(edge check) Attempted to add hyperedge where hyper==FALSE in addEdges_R. Exiting."); if(!hasLoops(x)) if(isLoop(outl,inl)) error("(edge check) Attempted to add loop-like edge where loops==FALSE in addEdges_R. Exiting."); if((!isMultiplex(x))&&(length(getListElement(x,"mel"))>0)){ mel=getListElement(x,"mel"); if(isDirected(x)){ for(i=0;i0){ /*Deal with attribute names*/ /*Rprintf("\tDealting with atl names\n");*/ PROTECT(atlnam = coerceVector(VECTOR_ELT(namesEval,z),STRSXP)); pc++; /*Coerce to str*/ /*Rprintf("\t\tSurvived coerce -- now checking length\n");*/ if(length(atlnam)>length(atl)){ warning("Too many labels in addEdges: wanted %d, got %d. Truncating name list.\n",length(atl),length(atlnam)); PROTECT(atlnam = contractList(atlnam,length(atl))); pc++; }else if(length(atlnam)0){ PROTECT(elem = allocVector(INTSXP,length(ptr)+1)); pc++; for(j=0;(j0){ PROTECT(elem = allocVector(INTSXP,length(ptr)+1)); pc++; for(j=0;(jopc){ UNPROTECT(pc-opc); pc=opc; } } } /*Rprintf("\tdone!\n");*/ /*Unprotect and return*/ UNPROTECT(pc); return x; } SEXP permuteVertexIDs(SEXP x, SEXP vids) { int i,j,k,pc=0,ccount=0,flag=0; char neigh[] = "combined"; SEXP eids,cvids,cpos,val,iel,oel,epl,mel,idlist,edge; PROTECT_INDEX ipx; /*Set up the initial variables*/ PROTECT(vids=coerceVector(vids,INTSXP)); pc++; PROTECT(cpos=allocVector(INTSXP,length(vids))); pc++; PROTECT(cvids=allocVector(INTSXP,length(vids))); pc++; PROTECT_WITH_INDEX(eids=allocVector(INTSXP,0),&ipx); pc++; /*Determine which vertices have moved, and accumulate affected edges*/ for(i=0;i(double)networkSize(x)) ||(vecMax(outl)>(double)networkSize(x))) error("(edge check) Illegal vertex reference in addEdge_R. Exiting."); /*If necessary, verify that new edge satisfies existing graph requirements*/ PROTECT(edgeCheck = coerceVector(edgeCheck, LGLSXP)); pc++; if(INTEGER(edgeCheck)[0]){ if(length(inl)*length(outl)==0) error("(edge check) Empty head/tail list in addEdge_R. Exiting."); if(!isHyper(x)) if(MAX(length(inl),length(outl))>1) error("(edge check) Attempted to add hyperedge where hyper==FALSE in addEdge_R. Exiting."); if(!hasLoops(x)) if(isLoop(outl,inl)) error("(edge check) Attempted to add loop-like edge where loops==FALSE in addEdge_R. Exiting."); if((!isMultiplex(x))&&(length(getListElement(x,"mel"))>0)){ mel=getListElement(x,"mel"); if(isDirected(x)){ for(i=0;i0){ /*Deal with attribute names*/ /*Rprintf("\tDealting with atl names\n");*/ PROTECT(atlnam = coerceVector(namesEval,STRSXP)); pc++; /*Coerce to str*/ /*Rprintf("\t\tSurvived coerce -- now checking length\n");*/ if(length(atlnam)>length(atl)){ warning("Too many labels in addEdge: wanted %d, got %d. Truncating name list.\n",length(atl),length(atlnam)); PROTECT(atlnam = contractList(atlnam,length(atl))); pc++; }else if(length(atlnam)0){ PROTECT(elem = allocVector(INTSXP,length(ptr)+1)); pc++; for(j=0;(j0){ PROTECT(elem = allocVector(INTSXP,length(ptr)+1)); pc++; for(j=0;(j0) Rprintf("\tFirst ID is %d\n",INTEGER(eids)[0]);*/ x=deleteEdges(x,eids); UNPROTECT(1); } /*Permute the vertices in vid to the end of the graph*/ /*Rprintf("\tPreparing to permute\n");*/ PROTECT(nord=allocVector(INTSXP,networkSize(x))); pc++; count=0; for(i=0;in)|| (INTEGER(vj)[i]>n)) INTEGER(ans)[i]=NA_INTEGER; /*Return NA on a bad query*/ else INTEGER(ans)[i]=isAdjacent(x,INTEGER(vi)[i],INTEGER(vj)[i], INTEGER(naOmit)[0]); /*Return the result*/ UNPROTECT(pc); return ans; } SEXP isNANetwork_R(SEXP x, SEXP y) /*Given input network x, create an edge in y for every edge of x having edge attribute na==TRUE. It is assumed that y is preallocated to be the same size and type as x -- this function just writes the edges into place.*/ { SEXP hl,tl,nel,vel,mel,edgeCheck; int i,pc=0,count=0; /*Get the master edge list of x*/ mel=getListElement(x,"mel"); /*Pre-allocate head/tail lists -- we'll shorten later*/ PROTECT(hl=allocVector(VECSXP,length(mel))); pc++; PROTECT(tl=allocVector(VECSXP,length(mel))); pc++; /*Move through the edges, copying head/tail lists only when missing*/ for(i=0;i # Last Modified 5/07/2016 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains the R/C initialization code # ###################################################################### */ #include #include #include #include "access.h" #include "constructors.h" #include "layout.h" #include "utils.h" #define CALLDEF(name, n) {#name,(DL_FUNC) &name, n} static R_CallMethodDef CallEntries[] = { CALLDEF(addEdge_R,6), CALLDEF(addEdges_R,6), CALLDEF(addVertices_R,3), CALLDEF(copyNetwork_R,1), CALLDEF(deleteEdgeAttribute_R,2), CALLDEF(deleteEdges_R,2), CALLDEF(getEdgeAttribute_R,5), CALLDEF(deleteNetworkAttribute_R,2), CALLDEF(deleteVertexAttribute_R,2), CALLDEF(deleteVertices_R,2), CALLDEF(getEdgeIDs_R,5), CALLDEF(getEdges_R,5), CALLDEF(getNeighborhood_R,4), CALLDEF(isAdjacent_R,4), CALLDEF(isNANetwork_R,2), CALLDEF(networkEdgecount_R,2), CALLDEF(permuteVertexIDs_R,2), CALLDEF(setEdgeAttribute_R,4), CALLDEF(setEdgeAttributes_R,4), CALLDEF(setEdgeValue_R,4), CALLDEF(setNetworkAttribute_R,3), CALLDEF(setVertexAttribute_R,4), CALLDEF(setVertexAttributes_R,4), CALLDEF(nonEmptyEdges_R,1), {NULL,NULL,0} }; static R_CMethodDef CEntries[] = { CALLDEF(network_layout_fruchtermanreingold_R,15), CALLDEF(network_layout_kamadakawai_R,10), {NULL,NULL,0} }; void R_init_network(DllInfo *dll) { R_registerRoutines(dll,CEntries,CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); /*Add back the various things required by the API.*/ /*Register access routines*/ R_RegisterCCallable("network", "getEdgeAttribute", (DL_FUNC) getEdgeAttribute); R_RegisterCCallable("network", "getEdgeIDs", (DL_FUNC) getEdgeIDs); R_RegisterCCallable("network", "getEdges", (DL_FUNC) getEdges); R_RegisterCCallable("network", "getNeighborhood", (DL_FUNC) getNeighborhood); R_RegisterCCallable("network", "getNetworkAttribute", (DL_FUNC) getNetworkAttribute); R_RegisterCCallable("network", "hasLoops", (DL_FUNC) hasLoops); R_RegisterCCallable("network", "isAdjacent", (DL_FUNC) isAdjacent); R_RegisterCCallable("network", "isDirected", (DL_FUNC) isDirected); R_RegisterCCallable("network", "isHyper", (DL_FUNC) isHyper); R_RegisterCCallable("network", "isLoop", (DL_FUNC) isLoop); R_RegisterCCallable("network", "isMultiplex", (DL_FUNC) isMultiplex); R_RegisterCCallable("network", "isNetwork", (DL_FUNC) isNetwork); R_RegisterCCallable("network", "networkEdgecount", (DL_FUNC) networkEdgecount); R_RegisterCCallable("network", "networkSize", (DL_FUNC) networkSize); /*Register modification routines*/ R_RegisterCCallable("network", "addEdge_R", (DL_FUNC) addEdge_R); R_RegisterCCallable("network", "addEdges_R", (DL_FUNC) addEdges_R); R_RegisterCCallable("network", "deleteEdgeAttribute", (DL_FUNC) deleteEdgeAttribute); R_RegisterCCallable("network", "deleteNetworkAttribute", (DL_FUNC) deleteNetworkAttribute); R_RegisterCCallable("network", "deleteVertexAttribute", (DL_FUNC) deleteVertexAttribute); R_RegisterCCallable("network", "setNetworkAttribute", (DL_FUNC) setNetworkAttribute); R_RegisterCCallable("network", "setVertexAttribute", (DL_FUNC) setVertexAttribute); /* Callable functions from other packages' C code */ #define RREGDEF(name) R_RegisterCCallable("network", #name, (DL_FUNC) name) RREGDEF(setListElement); RREGDEF(getListElement); } network/vignettes/0000755000176200001440000000000014061532363013756 5ustar liggesusersnetwork/vignettes/networkVignette.Rnw0000644000176200001440000023443013357022000017640 0ustar liggesusers\documentclass[article,shortnames,nojss]{jss} %\documentclass{article} \usepackage{amsfonts,amssymb,amsthm,amsmath,rotating} %\usepackage{natbib} %for easy biblo %\usepackage{hyperref} %for url links %\usepackage{comment} %\usepackage{color} %\VignetteIndexEntry{network Vignette} \author{Carter T.\ Butts\\ University of California, Irvine} \Plainauthor{Carter T. Butts} \title{\pkg{network}: A Package for Managing Relational Data in \proglang{R}} \Plaintitle{network: A Package for Managing Relational Data in R} \Shorttitle{\pkg{network}: Managing Relational Data in \proglang{R}} \Abstract{ Effective memory structures for relational data within \proglang{R} must be capable of representing a wide range of data while keeping overhead to a minimum. The \pkg{network} package provides an class which may be used for encoding complex relational structures composed a vertex set together with any combination of undirected/directed, valued/unvalued, dyadic/hyper, and single/multiple edges; storage requirements are on the order of the number of edges involved. Some simple constructor, interface, and visualization functions are provided, as well as a set of operators to facilitate employment by end users. The package also supports a \proglang{C}-language API, which allows developers to work directly with \pkg{network} objects within backend code.} \Keywords{relational data, data structures, graphs, \pkg{network}, \pkg{statnet}, \proglang{R}} \Plainkeywords{relational data, data structures, graphs, network, statnet, R} \Volume{24} \Issue{2} \Month{February} \Year{2008} \Submitdate{2007-06-01} \Acceptdate{2007-12-25} \Address{ Carter T.\ Butts\\ Department of Sociology and Institute for Mathematical Behavioral Sciences\\ University of California, Irvine\\ Irvine, CA 92697-5100, United States of America\\ E-mail: \email{buttsc@uci.edu}\\ URL: \url{http://www.faculty.uci.edu/profile.cfm?faculty_id=5057} } \begin{document} \definecolor{Sinput}{rgb}{0.19,0.19,0.75} \definecolor{Soutput}{rgb}{0.2,0.3,0.2} \definecolor{Scode}{rgb}{0.75,0.19,0.19} \DefineVerbatimEnvironment{Sinput}{Verbatim}{formatcom = {\color{Sinput}}} \DefineVerbatimEnvironment{Soutput}{Verbatim}{formatcom = {\color{Soutput}}} \DefineVerbatimEnvironment{Scode}{Verbatim}{formatcom = {\color{Scode}}} \renewenvironment{Schunk}{}{} \SweaveOpts{concordance=TRUE} PLEASE NOTE: This document has been modified from the original paper to form a package vignette. It has been compiled with the version of the network package it is bundled with, and has been partially updated to reflect some changes in the package. The original paper is:\\ \pkg{network}: A Package for Managing Relational Data in \proglang{R}. \emph{Journal of Statistical Software} 24:2, 2008. \url{http://www.jstatsoft.org/v24/i02/paper} \section{Background and introduction} In early 2002, the author and several other members of what would ultimately become the \pkg{statnet} project \citep{statnet} came to the conclusion that the simple, matrix-based approach to representation of relational data utilized by early versions of packages such as \pkg{sna} were inadequate for the next generation of relational analysis tools in \proglang{R}. Rather, what was required was a customized class structure to support relational data. This class structure would be used for all \pkg{statnet} packages, thus insuring interoperability; ideally, it would also be possible to port this structure to other languages, thereby further enhancing compatibility. The requirements which were posed for a network data class were as follows, in descending order of priority: \begin{enumerate} \item The class had to be sufficiently general to encode all major types of network data collected presently or in the foreseeable future; \item Class storage needed to be of sufficient efficiency to permit representation of large networks (in particular, storage which was sub-quadratic in graph order for sparse networks); and \item It had to be possible to develop interface methods to the class which were of reasonable computational efficiency. \end{enumerate} Clearly, there are multiple approaches which could be taken to construct such a class structure. Here we describe the result of one particular effort, specifically the \pkg{network} package \citep{network} for the \proglang{R} system for statistical computing \citep{R}. \subsection{Historical note} The \pkg{network} package as described here evolved from a specification originally written as an unpublished working paper, ``Memory Structures for Relational Data in \proglang{R}: Classes and Interfaces'' \citep{butts:tr:2002}. At this time, the class in question was tentatively entitled ``graph.'' It subsequently emerged that a similar package was being developed by Robert Gentleman under the \pkg{graph} title (as part of the BioConductor project) \citep{gentleman.et.al:sw:2007}, and the name of the present project was hence changed to ``network'' in early 2005. A somewhat later version of the above relational data specification was also shared with Gabor Csardi in mid-2004, portions of which were incorporated in the development by Gabor of the \pkg{igraph} package \citep{gabor:sw:2007}. As a result, there are currently three commonly available class systems for relational data in \proglang{R}, two of which (\pkg{network} and \pkg{igraph}) share some common syntax and interface concepts. It should also be noted that (as mentioned above) both standard and sparse matrix \citep[e.g., \pkg{sparseM}][]{koenker.ng:sw:2007} classes have been and continue to be used to represent relational data in \proglang{R}. This article does not attempt to address the relative benefits and drawbacks of these different tools, but readers should be aware that multiple alternatives are available. \subsection{A very quick note on notation} Throughout this paper we will use ``graph'' or ``network'' ($G$) generically to refer to any relational structure on a given vertex set ($V$), and ``edge'' to refer to a generalized edge (i.e., an ordered pair $(T,H)$ where $T$ is the ``tail set'' of the edge and $H$ is the corresponding ``head set,'' and where $T,H \subseteq V(G)$). The cardinality of the vertex set we denote $|V(G)|=n$, and the cardinality of the corresponding edge set we likewise denote $|E(G)|=m$. When discussing storage/computational complexity we will often use a loose order notation, where $\mathcal{O}\bigl(f\left(x\right)\bigr)$ is intended to indicate that the quantity in question grows more slowly than $f(x)$ as $x \to \infty$. A general familiarity with the \proglang{R} statistical computing system (and related syntax/terminology) is assumed. Those unfamiliar with \proglang{R} may wish to peruse a text such as those of \citet{venables.ripley:bk:2000,venables.ripley:bk:2002} or \citet{chambers:bk:1998}. \section[The network class]{The \code{network} class} The \code{network} class is a (reasonably) simple object structure designed to store a single relation on a vertex set of arbitrary size. The relation stored by a \code{network} class object is based on a generalized edge model; thus, edges may be directed, arbitrarily valued (with multiple values per edge), multiplex (i.e., multiple edges per directed dyad), hyper (i.e., multiple head/tail vertices per edge), etc. Storage requirements for the \code{network} class are on the order of the number of nodes plus the total number of edges (which is substantially sub-$n^2$ for sparse graphs), and retrieval of edge values has a time complexity which is no worse than $\mathcal{O}(n)$.\footnote{Edge retrieval actually scales with degree, and average retrieval time is hence approximately constant for many data sources. For an argument regarding constraints on the growth of mean degree in interpersonal networks, see e.g., \citet{mayhew.levinger:ajs:1976}.} For example, a network with 100,000 vertices and 100,000 edges currently consumes approximately 74MB of RAM (\proglang{R} 2.6.1), versus approximately 40GB for a full sociomatrix (a savings of approximately 99.8\%). When dealing with extremely large, sparse graphs it therefore follows that \code{network} objects are substantially more efficient than simpler representations such as adjacency matrices. The class also provides for the storage of arbitrary metadata at the edge, vertex, and network level. Thus, \code{network} objects may be preferred to matrix representations for reasons of generality, performance, or integrative capability; while alternative means exist of obtaining these goals separately, \pkg{network} provides a single toolkit which is designed to be effective across a wide range of applications. In this section, we provide a basic introduction to the \code{network} class, from a user's point of view. We describe the conditions which are necessary for \pkg{network} to be employed, and the properties of \code{network} objects (and their components). This serves as background for a discussion of the use of \pkg{network} methods in practical settings, which is given in the section which follows. \subsection{Identification of vertices and edges} For purposes of storage, we presume that each vertex and each edge can be uniquely identified. \citep[For partially labeled or unlabeled graphs, observe that this internal labeling is essentially arbitrary. See][for a discussion.]{butts.carley:cmot:2005} Vertices are labeled by positive integers in the order of entry, with edges likewise; it is further assumed that this is maintained for vertices (e.g., removing a vertex requires relabeling) but not for edges. (This last has to do with how edges are handled internally, but has the desirable side effect of making edge changes less expensive.) Vertices and edges are always stored by label. In the text that follows, any reference to a vertex or edge ``ID'' refers to these labeling numbers, and not to any other (external) identification that a vertex or edge may have. \subsection{Basic class structure} Functionally, a \code{network} object can be thought as a collection of vertices and edges, together with metadata regarding those vertices and edges (as well as the network itself). As noted above, each vertex is assumed to be identifiable, and the number of vertices is fixed. Here, we discuss the way in which edges are defined within \pkg{network}, as well as the manner in which associated metadata is stored. \subsubsection{Edge structure} Edges within a \code{network} object consist of three essential components. First, each edge contains two vectors of vertex IDs, known respectively as the \emph{head} and \emph{tail} lists of the edge. In addition to these lists, each edge also contains a list of attribute information. This is discussed in more detail below. The content and interpretation of the head and tail lists are dependent on the type of network in which they reside. In a directed network, an edge connects the elements of its tail list with those of its head list, but not vice versa: $i$ is adjacent to $j$ iff there exists some edge, $e=(T,H)$, such that $i\in T, j\in H$. In an undirected network, by contrast, the head and tail sets of an edge are regarded as exchangeable. Thus, $i$ is adjacent to $j$ in an undirected network iff there exists an edge such that $i\in T, j\in H$ or $i\in H, j\in T$. \pkg{network} methods which deal with adjacency and incidence make this distinction transparently, based on the network object's directedness attribute (see below). Note that in the familiar case of dyadic networks (the focus of packages such as \pkg{sna} \citep{sna}), the head and tail lists of any given edge must have exactly one element. This need not be true in general, however. An edge with a head or tail list containing more than one element is said to be \emph{hypergraphic}, reflecting a one-to-many, many-to-one, or many-to-many relationship. Hyperedges are permitted natively within \pkg{network}, although some methods may not support them -- a corresponding network attribute is used by \pkg{network} methods to determine whether these edges are present, as explained below. Finally, another fundamental distinction is made between edges in which $H$ and $T$ are disjoint, versus those in which these endpoint lists have one or more elements in common. Edges of the latter type are said to be \emph{loop-like}, generalizing the familiar notion of ``loop'' (self-tie) from the theory of dyadic graphs. Loop-like edges allow vertices to relate to themselves, and are disallowed in many applications. Applicable methods are expected to interpret such edges intelligently, where present. \subsubsection[network attributes]{\code{network} attributes} \label{sec_net_attr} As we have already seen, each \code{network} object contains a range of metadata in addition to relational information. This metadata -- in the form of attributes -- is divided into information stored at the network, vertex, and edge levels. In all three cases, attributes are stored in \code{list}s, and are expected to be named. While there is no limit to the user-defined attributes which may be stored in this manner, certain attributes are required of all \code{network} objects. At the network level, such attributes describe general properties of the network as a whole; specifically, they may be enumerated as follows: \begin{description} \item[\code{bipartite}] This is a \code{logical} or \code{numeric} attribute, which is used to indicate the presence of an intrinsic bipartition in the \code{network} object. Formally, a bipartition is a partition of a network's vertices into two classes, such that no vertex in either class is adjacent to any vertex in the same class. While such partitions occur naturally, they may also be specifically enforced by the nature of the data in question. (This is the case, for instance, with two-mode networks \citep{wass:faus1994}, in which edges represent connections between two distinct classes of entities.) In order to allow for bipartite networks with a partition size of zero, non-bipartite networks are marked as \code{bipartite=FALSE}. Where the value of \code{bipartite} is numeric, \pkg{network} methods will automatically assume that vertices with IDs less than or equal to \code{bipartite} belong to one such class, with those with IDs greater than \code{bipartite} belonging to the other. This information may be used in selecting default modes for data display, calculating numbers of possible edges, etc. When \code{bipartite == FALSE} or {NULL}, by contrast, no such bipartition is assumed. Because of the dual \code{logical}/\code{numeric} nature of the attribute, it is safest to check it using the \code{is.bipartite} method. It should be emphasized that \code{bipartite} is intended to reflect bipartitions which are required \emph{ex ante,} rather than those which happen to arise empirically. There is also no performance advantage to the use of \code{bipartite}, since \pkg{network} only stores edges which are defined; it can make data processing more convenient, however, when working with intrinsically bipartite structures. \item[\code{directed}] This is a \code{logical} attribute, which should be set to \code{TRUE} iff edges are to be interpreted as directed. As explained earlier, \pkg{network} methods will regard edge endpoint lists as exchangeable when \code{directed} is \code{FALSE}, allowing for automatic handling of both directed and undirected networks. For obvious reasons, misspecification of this attribute may lead to surprising results; it is generally set when a \code{network} object is created, and considered fixed thereafter. \item[\code{hyper}] This attribute is a \code{logical} variable which is set to \code{TRUE} iff the network is allowed to contain hyperedges. Since the vast majority of network data is dyadic, this attribute defaults to \code{FALSE} for must construction methods. The setting of \code{hyper} to \code{TRUE} has potentially serious implications for edge retrieval, and so methods should not activate this option unless hypergraphic edges are explicitly to be permitted. \item[\code{loops}] As noted, loop-like edges are frequently undefined in practical settings. The \code{loops} attribute is a \code{logical} which should be set to \code{TRUE} iff such edges are permitted within the network. \item[\code{multiple}] In most settings, an edge is uniquely defined by its head and tail lists. In other cases, however, one must represent data in which multiple edges are permitted between the same endpoints. (``Same'' here includes the effect of directedness; an edge from set $H$ to set $T$ is not the same as an edge from set $T$ to set $H$, unless the network is undirected.) The \code{multiple} attribute is a \code{logical} variable which is set to \code{TRUE} iff such multiplex edges are permitted within the network. Where \code{multiple} is \code{FALSE}, \pkg{network} methods will assume all edges to be unique -- like \code{directed}, the possibility of multiplex edges thus can substantially impact both behavior and performance. For this reason, \code{multiple} is generally set to \code{FALSE} by default, and should not be set to \code{TRUE} unless it is specifically necessary to permit multiple edges between the same endpoint sets. \item[\code{n}] Finally, \code{n} is a \code{numeric} attribute containing the number of elements in the vertex set. Applicable methods are expected to adjust this attribute up or down, should vertices be added or deleted from the network. Note that as of \pkg{network} v1.8, networks of size zero are permitted. \end{description} While these attributes are clearly reserved, any number of others may be added. Attributes specifically pertaining to edges and/or vertices can be stored at the network level, but this is generally non-optimal -- such attributes would have to be manually updated to reflect edge or vertex changes, and would require the creation of custom access methods. The preferred approach is to store such information directly at the edge or vertex level, as we discuss below. \subsubsection[Vertex attributes]{Vertex attributes} As with the network as a whole, it is often useful to be able to supply attribute data for individual vertices (e.g., names, attributes, etc.). Each vertex thus has a \code{list} of named attributes, which can be used to store arbitrary information on a per-vertex basis; there is no restriction on the type of information which may be stored in this fashion, nor are all vertices constrained to carry information regarding the same attributes. Each vertex does carry two special attributes, however, which are assumed to be available to all class methods. These are \code{vertex.names}, which must be a \code{character} containing the name of the vertex, and the \code{logical} attribute \code{na}. Where \code{TRUE}, \code{na} indicates that the associated vertex is unobserved; this is useful in cases for which individual entities are known to belong to a given network, but where data regarding those entities is unavailable. By default, \code{na} is set to \code{FALSE} and \code{vertex.names} is set equal to the corresponding vertex ID. \subsubsection[Edge attributes]{Edge attributes} Just as vertices can carry attributes, so too can edges. Each edge is endowed with a \code{list} of named attributes, which can be used to carry arbitrary information (e.g., tie strength, onset and termination times, etc.). As with vertex attributes, any information type may be employed and there is no requirement that all edges carry the same attributes. The one attribute required to be carried by each edge is \code{na}, a \code{logical} which (like the vertex case) is used to indicate the missingness of a given edge. Many \pkg{network} methods provide the option of filtering out missing edges when retrieving information, and/or returning the associated information (e.g., adjacency) as missing. \section[Using the network class]{Using the \code{network} class} In addition to the class itself, \pkg{network} provides a range of tools for creating, manipulating, and visualizing \code{network} objects.\footnote{These tools are currently implemented via S3 methods.} Here, we provide an overview of some of these tools, with a focus on the basic tasks most frequently encountered by end users. Additional information on these functions is also provided within the package manual. For the examples below, we begin by loading the network package into memory; we also set the random seed, to ensure that examples using random data match the output shown here. Within \proglang{R}, this may be accomplished via the following: <<>>= library(network) set.seed(1702) @ Throughout, we will represent \proglang{R} code in the above format. Readers may wish to try the demonstrations listed here for themselves, to get a better feel for how the package operates. \subsection{Importing data} It almost goes without saying that an important aspect of \pkg{network} functionality is the ability to import data from external sources. \pkg{network} includes functionality for the importation of \pkg{Pajek} project files \citep{pajek}, a popular and versatile network data format, via the \code{read.paj} routine. Other formats supported by \pkg{sna} can be used as well, by importing to adjacency matrix form (using the relevant \pkg{sna} routines) and then coercing the result into a \code{network} object as described below. The \pkg{foreign} package can be used to import adjacency, edgelist, or incidence matrices from other computing environments in much the same way. Future package versions may include support for converting to and from other related classes, e.g., those of \pkg{RBGL} \citep{carey.et.al:sw:2007} and \pkg{Rgraphviz} \citep{gentry.et.al:sw:2007}. In addition to these methods, \code{network} objects can be loaded into \proglang{R} using native tools such as \code{load} (for saved objects) or \code{data} (for packaged data sets). With respect to the latter, \pkg{network} contains two sample data sets: \code{flo}, John Padgett's Florentine wedding data \citep[from][]{wass:faus1994}; and \code{emon}, a set of interorganizational networks from search and rescue operations collected by \citet{drabek.et.al:bk:1981}. \code{flo} consists of a single adjacency matrix, and is useful for illustrating the process of converting data from adjacency matrix to \code{network} form. \code{emon}, on the other hand, consists of a list of seven \code{network} objects with vertex and edge metadata. \code{emon} is thus especially useful for illustrating the use of \code{network} objects for rich data storage (in addition to being an interesting data set in its own right). Loading these data sets is as simple as invoking the \code{data} command, like so: <<>>= data("flo") data("emon") @ Further information on each of these data sets is given in the \pkg{network} manual. We shall also use these data sets as illustrative examples at various points within this paper. \subsection[Creating and viewing network objects]{Creating and viewing \code{network} objects} While importation is sometimes possible, in other cases we must create our own \code{network} objects. \pkg{network} supports two basic approaches to this task: create the object from scratch, or build it from existing relational data via coercion. Both methods are useful, and we illustrate each here. In the most minimal case, we begin by creating an empty network to which edges may be added. This task is performed by the \code{network.initialize} routine, which serves as a constructor for the \code{network} class. \code{network.initialize} takes the order of the desired graph (i.e., $n$) as a required argument, and the required network attributes discussed in Section~\ref{sec_net_attr} may be passed as well. In the event that these are unspecified, it is assumed that a simple digraph (directed, no loops, hyperedges, multiplexity, or bipartitions) is desired. For example, one may create and print an empty digraph like so: <<>>= net <- network.initialize(5) net @ \pkg{network} has default \code{print} and \code{summary} methods, as well as low-level operators for assignment and related operations. These do not show much in the above case, since the network in question caries little information. To create a \code{network} along with a specified set of edges, the preferred high-level constructor is the eponymous \code{network}. Like \code{network.initialize}, this function returns a newly allocated \code{network} object having specified properties. Unlike the former, however, \code{network} may be called with adjacency and/or attribute information. Adjacency information may be passed by using a full or bipartite adjacency matrix, incidence matrix, or edgelist as the function's first argument. These input types are defined as follows: \begin{description} \item[Adjacency matrix:] This must consist of a square \code{matrix} or two-dimensional \code{array}, whose $i,j$th cell contains the value of the edge from $i$ to $j$; as such, adjacency matrices may only be used to specify dyadic networks. By default, edges are assumed to exist for all non-zero matrix values, and are constructed accordingly. Edge values may be retained by passing \code{ignore.eval = FALSE}, as described in the manual page for the \code{network.adjacency} constructor. The \code{matrix.type} for an adjacency matrix is \code{"adjacency"}. \item[Bipartite adjacency matrix:] This must consist of a rectangular \code{matrix} or two-dimensional \code{array} whose row and column elements reflect vertices belonging to the lower and upper sets of a bipartition (respectively). Otherwise, the matrix is interpreted as per a standard adjacency matrix. (Thus, a bipartite adjacency matrix is simply the upper off-diagonal block of the full adjacency matrix for a bipartite graph, where vertices have been ordered by partition membership. See also \citet{doreian.et.al:bk:2005}.) The \code{matrix.type} for a bipartite adjacency matrix is \code{"bipartite"}. \item[Incidence matrix:] This must consist of a rectangular \code{matrix} or two-dimensional \code{array} whose row elements represent vertices, and whose column elements represent edges. A non-zero value is placed in the $i,j$th cell if vertex $i$ is an endpoint of edge $j$. In the directed case, negative values signify membership in the tail set of the corresponding edge, while positive values signify membership in the edge's head set. Unlike adjacency matrices, incidence matrices can thus be used to describe hypergraphic edges (directed or otherwise). Note, however, that an undirected hypergraph composed of two-endpoint edges is not the same as a simple graph, since the edges of the former are necessarily loop-like. When \code{loops}, \code{hyper}, and \code{directed} are all \code{FALSE}, therefore, the two positive row-elements of an incidence matrix for each column are taken to signify the head and tail elements of a dyadic edge. (This is without loss of generality, since such an incidence matrix would otherwise be inadmissible.) When specifying that an incidence matrix is to be used, \code{matrix.type} should be set to \code{"incidence"}. \item[Edge list:] This must consist of a rectangular \code{matrix} or two-dimensional \code{array} whose row elements represent edges. The $i,1$st cell of this structure is taken to be the ID of the tail vertex for the edge with ID $i$, with the $i,2$st cell containing the ID of the edge's head vertex. (Only dyadic networks may be input in this fashion.) Additional columns, if present, are taken to contain edge attribute values. The \code{matrix.type} for an edge list is \code{"edgelist"}. \end{description} As one might suspect, the \code{network} function actually operates by first calling \break\code{network.initialize} to create the required object, and then calling an appropriate edge set constructor based on the input type. This fairly modular design allows for the eventual inclusion of a wider range of input formats (although the above covers the formats currently in widest use within the social network community). Although \code{network} attempts to infer the matrix type from context, is wise to fix the function's behavior via the \code{matrix.type} argument when passing information which is not in the default, adjacency matrix form. As a simple example of the \code{network} constructor in action, consider the following: %\begin{Code} %#Create a less empty network %nmat <- matrix(rbinom(25,1,0.5),nr=5,nc=5) #Generate a random adjacency % #matrix %net <- network(nmat,loops=TRUE) #Use it to create a digraph % #w/loops %net #Display using print method %summary(net) #Display using summary method %all(nmat==net[,]) #Should be TRUE %\end{Code} <<>>= nmat <- matrix(rbinom(25, 1, 0.5), nr = 5, nc = 5) net <- network(nmat, loops = TRUE) net @ <<>>= summary(net) @ <<>>= all(nmat == net[,]) @ Here, we have generated a random adjacency matrix (permitting diagonal elements) and used this to construct a digraph (with loops) in \code{network} object form. Since we employed an adjacency matrix, there was no need to set the matrix type explicitly; had we failed to set \code{loops = TRUE}, however, the diagonal entries of \code{nmat} would have been ignored. The above example also demonstrates the use of an important form of operator overloading which can be used with dyadic network objects: specifically, dyadic network objects respond to the use of the subset and subset assignment operators \code{[} and \code{[<-} as if they were conventional adjacency matrices. Thus, in the above case, \code{net[,]} returns \code{net}'s adjacency matrix (a fact we verify by comparing it with \code{nmat}). This is an extremely useful ``shorthand'' which can be used to simplify otherwise cumbersome network operations, especially on small networks. The use of \code{network} function to create objects from input matrices has a functional parallel in the use of coercion methods to transform other objects into \code{network} form. These operate in the same manner as the above, but follow the standard \proglang{R} syntax for coercion, e.g.: %\begin{Code} %#Can also use coercion %net <- as.network(nmat, loops = TRUE) %all(nmat==net[,]) #Should still be TRUE %\end{Code} <<>>= net <- as.network(nmat, loops = TRUE) all(nmat == net[,]) @ By default, \code{as.network} assumes that square input matrices should be treated as adjacency matrices, and that diagonal entries should be ignored; here we have overridden the latter behavior by invoking the additional argument \code{loops = TRUE}. Matrix-based input can also be given in edgelist or incidence matrix form, as selected by the \code{matrix.type} argument. This and other options are described in greater detail within the package documentation. The above methods can be used in conjunction with \code{data}, \code{load}, or \code{read} functions to convert imported relational data into \code{network} form. For example, we may apply this to the Florentine data mentioned in the previous section: <<>>= nflo <- network(flo, directed = FALSE) nflo @ Although the network's adjacency structure is summarized here in edgelist form, it may be queried in other ways. For instance, the following example demonstrates three simple methods for examining the neighborhood of a particular vertex: <<>>= nflo[9,] nflo[9,1] nflo[9,4] is.adjacent(nflo, 9, 1) is.adjacent(nflo, 9, 4) @ As the example shows, overloading can be used to extract partial as well as complete adjacency information from a \code{network} object. A more cumbersome (but slightly faster) method is to use a direct call to \code{is.adjacent}, the general indicator method for network adjacency. Calling the indicator method avoids the call parsing required by the extraction operator, which is the source of the performance difference. In practice, however, the impact of call parsing is quite minimal, and users are unlikely to detect a difference between the two approaches. (Where such overhead is an issue, it will generally be more efficacious to conduct adjacency queries directly from the backend code; this will be discussed below, in the context of the \proglang{C}-language API.) In addition to adjacency, \pkg{network} supplies methods to query many basic properties of \code{network} objects. Although complex structural descriptives \citep[e.g., centrality scores][]{wass:faus1994} are the province of other packages, \pkg{network}'s built-in functionality is sufficient to determine the types of edges allowed within a \code{network} object and constraints such as enforced bipartitions, as well as essential quantities such as size (number of vertices), edge count, and density (the ratio of observed to potential edges). Use of these indicator methods is straightforward, as illustrated by the following examples. <<>>= network.size(nflo) #Number of vertices network.edgecount(nflo) #Number of edges network.density(nflo) #Network density has.loops(nflo) #Can nflo have loops? is.bipartite(nflo) #Is nflo coded as bipartite? is.directed(nflo) #Is nflo directed? is.hyper(nflo) #Is nflo hypergraphic? is.multiplex(nflo) #Are multiplex edges allowed? @ \subsection[Coercing network objects to other forms]{Coercing \code{network} objects to other forms} Just as one may often seek to coerce data from other forms into \code{network} object, so to does one sometimes need to coerce \code{network} objects into other data types. \pkg{network} currently supports several such coercion functions, all of which take network objects as input and produce matrices of one type or another. The class method for \code{as.matrix} performs this task, converting network objects to adjacency, incidence, or edgelist matrices as desired (adjacency being the default). Scalar-valued edge attributes, where present, may be used to set edge values using the appropriate functional arguments. Similar functionality is provided by \code{as.sociomatrix} and the extraction operator, although these are constrained to produce adjacency matrices. These equivalent approaches may be illustrated with application to the Florentine data as follows: <<>>= as.sociomatrix(nflo) all(nflo[,]==as.sociomatrix(nflo)) all(as.matrix(nflo)==as.sociomatrix(nflo)) as.matrix(nflo,matrix.type="edgelist") @ Note that vertex names (per the \code{vertex.names} attribute) are used by \code{as.sociomatrix} to set adjacency matrix row/column names where present. The less-flexible \code{as.sociomatrix} function also plays an important role with respect to coercion in the \pkg{sna} package; the latter's \code{as.sociomatrix.sna} dispatches to \pkg{network}'s \code{as.sociomatrix} routine when \pkg{network} is loaded and a \code{network} object is given. The intent in both packages is to maintain an interoperable and uniform mechanism for guaranteeing adjacency matrix representations of input data (which are necessary for backward compatibility with some legacy functions). \subsection{Creating and modifying edges and vertices} In addition to coercion of data to \code{network} form, the \pkg{network} package contains many mechanisms for creating, modifying, and removing edges and vertices from \code{network} objects. The simplest means of manipulating edges for most users is the use of the overloaded extraction and assignment operators, which (as noted previously) simulate the effects of working with an adjacency matrix. Thus, a statement such as \code{g[i,j] <- 1} adds an edge between \code{i} and \code{j} (if one is not already present), \code{g[i,j] <- 0} removes an existing edge, and \code{g[i,j]} itself is a dichotomous indicator of adjacency. Subset selection and assignment otherwise works in the same fashion as for \proglang{R} matrices, including the role of \code{logical}s and element lists. (One minor exception involves the effects of assignment on undirected and/or loopless graphs: \pkg{network} will enforce symmetry and/or empty diagonal entries, and will ignore any assignments which are contrary to this.) The uses of assignment by overloading are hence legion, as partially illustrated by the following: <<>>= #Add edges to an empty network net <- network.initialize(5,loops=TRUE) net[nmat>0] <- 1 #One way to add edges all(nmat==net[,]) #Should be TRUE net[,] <- 0 #Remove the edges net[,] <- nmat #Not quite kosher, but _will_ work.... all(nmat==net[,]) #Should still be TRUE net[,] <- 0 #Remove the edges for(i in 1:5) #Add the hard way! for(j in 1:5) if(nmat[i,j]) net[i,j] <- 1 all(nmat==net[,]) #Should STILL be TRUE net[,] <- 0 #Remove the edges add.edges(net,row(nmat)[nmat>0],col(nmat)[nmat>0]) all(nmat==net[,]) #When will it all end?? net[,] <- as.numeric(nmat[,]) all(nmat==net[,]) #When will it all end?? @ The above example also introduces \code{add.edges}, to which the overloaded assignment operator is a front end. \code{add.edges} is more cumbersome to employ than the assignment operators, but is substantially more powerful. In particular, it can be used to add edges of arbitrary type, with arbitrary attribute data. A comparison of usage is instructive; we begin by creating an empty digraph, and adding a single edge: <<>>= #Add edges (redux) net<-network.initialize(5) #Create empty graph add.edge(net,2,3) #Create 2->3 edge net[,] #Trust, but verify add.edges(net,c(3,5),c(4,4)) #3 and 5 send ties to 4 net[,] #Again, verify edges net[,2]<-1 #Everyone sends ties to 2 net[,] #Note that loops are not created! @ Observe that the (2,2) loop is not created, since \code{loops} is \code{FALSE} for this network. This automatic behavior is \emph{not} true of \code{add.edges}, unless optional edge checking is turned on (by means of the \code{edge.check} argument). For this reason, explicit use of \code{add.edges} is discouraged for novice users. In addition to edge addition/removal, vertices can be added or removed via \code{add.vertices} and \code{delete.vertices}. The former adds the specified number of vertices to a \code{network} object (along with any supplied attribute information), while the latter deletes a specified list of vertices from its argument. Usage is straightforward: <<>>= #Deleting vertices delete.vertices(net,4) #Remove vertex 4 net[,] #It's gone! add.vertices(net,2) #Add two new vertices net[,] #Both are isolates @ As the above illustrates, vertex names are not automatically created for newly added vertices\footnote{See the ``Persistent ID'' functionality in the the networkDynamic package for maintainable ids} (but can be subsequently assigned). New vertices are always added as isolates (i.e., without existing ties), and any edges having a deleted vertex as an endpoint are removed along with the deleted vertex. The use of \code{is.adjacent} (and friends) to perform adjacency testing has been shown above. While this is adequate for many purposes, it is sometimes necessary to examine an edge's contents in detail. As we have seen, each edge can be thought of as a list made up of a vector of tail vertex IDs, a vector of head vertex IDs, and a vector of attributes. The utility function \code{get.edges} retrieves edges in this form, returning them as lists with elements \code{inl} (tail), \code{outl} (head), and \code{atl} (attributes). \code{get.edges} allows for edges to be retrieved by endpoint(s), and is usable even on multiplex networks. Incoming or outgoing edges (or both) can be selected, as per the following example: <<>>= #Retrieving edges get.edges(net,1) #Out-edges sent by vertex 1 get.edges(net,2,neighborhood="in") #In-edges to vertex 2 get.edges(net,1,alter=2) #Out-edges from 1 to 2 @ The \code{alter} argument in the last case tells \code{get.edges} to supply only edges from vertex 1 to vertex 2. As with other applications of \code{get.edges}, this will return all applicable edges in the multiplex case. Retrieving edges themselves is useful, but does not provide the edges' ID information -- particularly in multiplex networks, such information is needed to delete or modify edges. For that purpose, we employ a parallel routine called \code{get.edgeIDs}: <<>>= #Retrieving edge IDs get.edgeIDs(net,1) #Same as above, but gets ID numbers get.edgeIDs(net,2,neighborhood="in") get.edgeIDs(net,1,alter=2) @ By the same token, it is sometimes the vertex neighborhood (rather than edge neighborhood) which is of interest. The \code{get.neighborhood} function can be used in these cases to obtain vertex neighborhoods directly, without having to first query edges. (Since this operation is implemented in the underlying compiled code, it is considerably faster than an \proglang{R}-level front end would be.) <<>>= #Vertex neighborhoods get.neighborhood(net,1) #1's out-neighbors get.neighborhood(net,2,type="in") #2's in-neighbors @ Finally, we note that edge deletion can be performed either by assignment operators (as noted above) or by the \code{delete.edges} function. \code{delete.edges} removes edges by ID, and hence is not primarily employed by end users. In conjunction with tools such as \code{get.edgeIDs}, however, it can be seen to be quite versatile. A typical example is as follows: <<>>= #Deleting edges net[2,3]<-0 #This deletes the 2->3 #edge net[2,3]==0 #Should be TRUE delete.edges(net,get.edgeIDs(net,2,neighborhood="in")) #Remove all->2 net[,] @ Since it works by IDs, it should be noted that \code{delete.edges} can be used to selectively remove edges from multiplex networks. The operator-based approach automatically removes any edges connecting the selected pair, and is not recommended for use with multiplex networks. \subsection{Working with attributes} A major advantage of \code{network} objects over simple matrix or list based data representations is the ability to store meta-information regarding vertices, edges, or the network as a whole. For each such attribute type, \pkg{network} contains access functions to manage the creation, modification, and extraction of such information. Here, we briefly introduce the primary functions used for these tasks, by attribute type. \subsubsection{Network attributes} As indicated previously, network-level attributes are those attached to the \code{network} object as a whole. Such attributes are created via the \code{set.network.attribute} function, which takes as arguments the object to which the attribute should be attached, the name of the attribute, and the value of the attribute in question. Network attributes may contain arbitrary data, as they are stored internally via generalized vectors (\code{list}s). To streamline the creation of such attributes, the network attribute operator, \code{\%n\%}, has also been provided. Assignment using the operator is performed via the syntax \code{network \%n\% "attrname" <- value}, as in the second portion of the example below (which assigns the first seven lowercase letters to an attribute called ``hoo'' in \code{net}). <<>>= net <- network.initialize(5) set.network.attribute(net, "boo", 1:10) net %n% "hoo" <- letters[1:7] @ After network attributes have been created, they may be listed using the \break\code{list.network.attributes} command. Attribute extraction may then be performed by a call to \code{get.network.attribute}, or via the network attribute operator. In the latter case, a call of the form \code{network \%n\% "attrname"} returns the value of attribute ``attrname'' in the object ``network.'' In our current example, for instance, we have created the attributes ``boo'' and ``hoo,'' each of which may be accessed using either method: <<>>= #List attributes list.network.attributes(net) #Retrieve attributes get.network.attribute(net,"boo") net %n% "hoo" @ Finally, it is sometimes desirable to remove network attributes which have been created. This is accomplished using \code{delete.network.attributes}, which removes the indicated attribute from the network object (freeing the associated memory). One can verify that the attribute has been removed by checking the list of network attributes, e.g: <<>>= #Delete attributes delete.network.attribute(net,"boo") list.network.attributes(net) @ \subsubsection{Vertex attributes} Vertex attributes are manipulated in the same general manner as network attributes, with the caveat that each vertex can have its own attributes. There is no requirement that all vertices have the same attributes, or that all attributes of a given name contain the same data type; however, not all extraction methods work well in the latter case. Complete functionality for arbitrary vertex creation, listing, retrieval, and deletion is provided by the \code{set.vertex.attribute}, \code{list.vertex.attributes}, \code{get.vertex.attribute}, and \break\code{delete.vertex.attribute} methods (respectively). These allow attribute data to be passed in list form (permitting arbitrary contents) and to be assigned to specific vertices. While the generality of these functions is helpful, they are cumbersome to use for simple tasks such as assigning scalar or character values to each vertex (or retrieving the same). To facilitate such routine tasks, \pkg{network} provides a vertex attribute operator, \code{\%v\%}. The operator may be used either for extraction or assignment, treating the right-hand value as a vector of attribute values (with the $i$th element corresponding to the $i$th vertex). By passing a \code{list} with a \code{list} for each element, one may assign arbitrary vertex values in this manner; however, the vertex operator will vectorize these values upon retrieval (and hence one must use \code{get.vertex.attribute} with \code{unlist = FALSE} to recover the full list structure). If a requested attribute is unavailable for a particular vertex, an \code{NA} is returned. Typical use of the vertex attribute methods is illustrated via the following example. Note that more complex usage is also possible, as detailed in the package manual. <<>>= #Add vertex attributes set.vertex.attribute(net,"boo",1:5) #Create a numeric attribute net %v% "hoo" <- letters[1:5] #Now, a character attribute #Listing attributes list.vertex.attributes(net) #List all vertex attributes #Retrieving attributes get.vertex.attribute(net,"boo") #Retrieve 'em net %v% "hoo" #Deleting attributes delete.vertex.attribute(net,"boo") #Remove one list.vertex.attributes(net) #Check to see that it's gone @ \subsubsection{Edge attributes} Finally, we come to edge attributes. The operations involved here are much like those for the network and vertex cases. List, set, get, and delete methods exist for edge attributes (\code{list.edge.attributes}, \code{set.edge.attribute}, \code{get.edge.attribute}, and \break\code{delete.edge.attribute}), as does an edge attribute operator (\code{\%e\%}). Operations with edges are rendered somewhat more complex, however, because of the need to employ edge IDs in referencing the edges themselves. These can be obtained via the \code{get.edgeIDs} function (as described above), but this adds complexity which is unnecessary in the case of simple attribute assignment on non-multiplex, dyadic graphs (where edges are uniquely identifiable by a pair of endpoints). For such cases, the convenience function \code{set.edge.value} allows edge values to be specified in adjacency matrix form. Also useful is the bracket operator, which can be used to assign values as well as to create edges. For network \code{net}, \code{net[sel, names.eval = "attrname"] <- value} will set the attribute named by ``attrname'' on the edges selected by \code{sel} (which follows standard \proglang{R} syntax for selection of cells from square matrices) to the values in \code{value}. By default, values for non-existent edges are ignored (although new edges can be created by adding \code{add.edges = TRUE} to the included arguments). Reasonable behavior for non-scalar values using this method is not guaranteed. In addition to the above, methods such as \code{as.sociomatrix} allow for edge attributes to be employed in some settings. These provide a more convenient (if less flexible) interface for the common case of scalar attributes on the edges of non-multiplex, dyadic networks. The following is a typical example of these routines in action, although much more exotic scenarios are certainly possible. <<>>= #Create a network with some edges net <- network(nmat) #Add attributes set.edge.attribute(net,"boo",sum(nmat):1) set.edge.value(net,"hoo",matrix(1:25,5,5)) #Note: only sets for extant edges! net %e% "woo" <- matrix(rnorm(25),5,5) #Ditto net[,,names.eval="zoo"] <- nmat*6 #Ditto if add.edges!=TRUE #List attributes list.edge.attributes(net) #Retrieving attributes get.edge.attribute(get.edges(net,1),"boo") #Get the attribute for 1's out-edges get.edge.value(net,"hoo") net %e% "woo" as.sociomatrix(net,"zoo") #Deleting attributes delete.edge.attribute(net,"boo") list.edge.attributes(net) @ As this example illustrates, edge attributes are only set for actually existing edges (although the optional \code{add.edges} argument to the network assignment operator can be used to force addition of edges with non-zero attribute values). Also illustrated is the difference between attribute setting using \code{set.edge.attribute} (which is edge ID based) and function such as the assignment operator. The relative ease of the latter recommends itself for everyday use, although more complex settings may call for the former approach. \subsubsection{From attributes to networks} In addition to simply storing covariate information, it should be noted that one can actively use attributes to construct new networks. For instance, consider the \code{emon} data set used above. Among other variables, each vertex carries an attribute called \code{"Location"} which contains information on whether the corresponding organization had headquarters or command post installations which were local, non-local, or both with respect to the operation from which the network was drawn. We may thus use this information to construct a very simple hypergraph, in which locations constitute edges and edge membership is defined as having an installation at the respective location. For the Mt.\ St.\ Helens network, such a network may be constructed as follows. First, we extract the location information from the relevant network object, and use this to build an incidence matrix based on location. Then we convert this incidence matrix to a hypergraphic network object (setting vertex names from the original network object for convenience). <<>>= #Extract location information MtSHloc<-emon$MtStHelens%v%"Location" #Build an incidence matrix based on Local/Non-local/Both placement MtSHimat<-cbind(MtSHloc%in%c("L","B"),MtSHloc%in%c("NL","B")) #Convert incidence matrix to a hypergraph MtSHbyloc<-network(MtSHimat,matrix="incidence",hyper=TRUE,directed=FALSE, loops=TRUE) #Set vertex names, for convenience MtSHbyloc%v%"vertex.names"<-emon$MtStHelens%v%"vertex.names" #Examine the result MtSHbyloc @ Obviously, the simple location coding used here cannot lead to a very complex structure. Nevertheless, this case serves to illustrate the flexibility of the \pkg{network} tools in allowing attribute information to be used in creative ways. In addition to constructing networks from attributes, one can use attributes to store networks \citep[useful for joint representation of cognitive and behavioral structures such as those of][]{krackhardt:sn:1988,killworth.bernard:ho:1976}, edge timing information (for dynamic structures, as in the package \pkg{networkDynamic} \citep{networkDynamic}), etc. Appropriate use of network, edge, and vertex attributes allows a wide range of complex relational data structures to be supported without the need for a cumbersome array of of custom data classes. \subsection[Visualizing network objects]{Visualizing \code{network} objects} In addition to manipulating \code{network} objects, the \pkg{network} package provides built-in support for network visualization. This capability is supplied by the package \code{plot} method (ported from \pkg{sna}'s \code{gplot}), which is dispatched transparently when \code{plot} is called with a \code{network} object. The plot method supports a range of layout and display options, which are specified through additional arguments. For instance, to visualize the Florentine marriage data we might use commands such as the following: <<>>= plot(nflo, displaylabels = TRUE, boxed.labels = FALSE) plot(nflo, displaylabels = TRUE, mode = "circle") @ Typical results of these commands are shown in Figure~\ref{f_nflo_layout}. Note that the plot method automatically determines whether the network being visualized is directed, and adds or suppresses arrowheads accordingly. For instance, compare the above with the Mt.\ Si communication network (Figure~\ref{f_mtsi}): \begin{figure} \begin{center} %\rotatebox{270}{\resizebox{3in}{6in}{\includegraphics{nflo.layouts.ps}}} %\rotatebox{270}{\resizebox{3in}{6in}{\includegraphics{Figures/nflo_layouts.pdf}}} <>= op<-par(no.readonly=TRUE) # cache the plot params par(mfcol=c(1,2),mar=c(1,1,1,1),cex=0.5) # adjust margins and text size to fit two panels plot(nflo, displaylabels = TRUE,boxed.labels = TRUE) plot(nflo, displaylabels = TRUE, mode = "circle") par(op) # reset the plot params @ \caption{\label{f_nflo_layout} Sample displays of the Florentine marriage data; the left panel depicts the default Fruchterman-Reingold layout, while the right panel depicts a circular layout.} \end{center} \end{figure} <<>>= plot(emon$MtSi) @ \begin{figure} \begin{center} %\rotatebox{270}{\resizebox{4in}{4in}{\includegraphics{mtsi.layout.ps}}} %\rotatebox{0}{\resizebox{4in}{4in}{\includegraphics{Figures/mtsi_layout.pdf}}} <>= plot(emon$MtSi) @ \caption{\label{f_mtsi} Sample display of the Mt.\ Si EMON data, using the default Fruchterman-Reingold layout.} \end{center} \end{figure} The default layout algorithm for the plot method is that of \citet{fruchterman.reingold:spae:1991}, a force-directed display with good overall performance. Other layout methods are available \citep[including the well-known energy-minimization algorithm of][]{kamada.kawai:ipl:1989}, and support is included for user-added functions. To create a custom layout method, one need only create a function with the prefix \code{network.layout} which supplies the appropriate formal arguments (see the \pkg{network} manual for details). The \code{plot} method can then be directed to utilize the custom layout function, as in this simple example (shown in Figure~\ref{f_mtsthelens_custom}): <<>>= library(sna) network.layout.degree <- function(d, layout.par){ id <- degree(d, cmode = "indegree") od <- degree(d, cmode = "outdegree") cbind(id, od) } plot(emon$MtStHelens, mode = "degree", displaylabels = TRUE, boxed.labels = FALSE, suppress.axes = FALSE, label.cex = 0.5, xlab = "Indegree", ylab = "Outdegree", label.col = 3) @ \begin{figure} \begin{center} %\rotatebox{270}{\resizebox{6in}{6in}{\includegraphics{mtsthelens.custom.layout.ps}}} %\rotatebox{270}{\resizebox{6in}{6in}{\includegraphics{Figures/mtsthelens_custom_layout.pdf}}} <>= plot(emon$MtStHelens, mode = "degree", displaylabels = TRUE, boxed.labels = FALSE, suppress.axes = FALSE, label.cex = 0.5, xlab = "Indegree", ylab = "Outdegree", label.col = 3) @ \caption{\label{f_mtsthelens_custom} Sample display of the Mt.\ St.\ Helens EMON data, using a custom indegree/outdegree layout.} \end{center} \end{figure} As this example illustrates, most properties of the visualization can be adjusted where necessary. This is especially helpful when visualizing structures such as hypergraphs: <<>>= plot(MtSHbyloc, displaylabels = TRUE, label = c(network.vertex.names(MtSHbyloc), "Local", "Non-Local"), boxed.labels = FALSE, label.cex = rep(c(0.5, 1), times = c(27, 2)), label.col = rep(c(3, 4), times = c(27, 2)), vertex.col = rep(c(2, 5), times = c(27, 2))) @ Note that the \code{plot} method automatically recognizes that the network being passed is hypergraphic, an employs a two-mode representation for visualization purposes (see Figure~\ref{f_mtsthelens_twomode}). Supplying custom labeling and vertex coloring helps clarify the interpretation. For instance, here we can immediately see the division between organizations who maintained headquarters exclusively at local or remote locations during the Mount St. Helens search and rescue operation, as well as those organizations (e.g. the Salvation Army and Red Cross) which bridged the two. Though simple, examples such as this demonstrate how the default \emph{plot} settings can be adjusted to produce effective visualizations of even complex relational data. \begin{figure} \begin{center} %\rotatebox{270}{\resizebox{4.5in}{6in}{\includegraphics{mtsthelens.twomode.ps}}} %\rotatebox{270}{\resizebox{4.5in}{6in}{\includegraphics{Figures/mtsthelens_twomode.pdf}}} <>= plot(MtSHbyloc, displaylabels = TRUE, label = c(network.vertex.names(MtSHbyloc), "Local", "Non-Local"), boxed.labels = FALSE, label.cex = rep(c(0.5, 1), times = c(27, 2)), label.col = rep(c(3, 4), times = c(27, 2)), vertex.col = rep(c(2, 5), times = c(27, 2))) @ \caption{\label{f_mtsthelens_twomode} Sample display of the Mt.\ St.\ Helens location hypergraph, showing division between locally, non-locally, and dual headquartered organizations.} \end{center} \end{figure} \section[C-language API]{\proglang{C}-language API} While the functionality described thus far has been aimed at users working within an interpreted \proglang{R} environment, many \pkg{network} package features can also be accessed through a \proglang{C}-language application programming interface (API). Although this API still makes use of \proglang{R} data structures, it provides mechanisms for direct manipulation of those structures via compiled code. While invisible to most end users, the API has a number of attractions for developers. Chief among these is performance: in the author's experience, a reasonably well-designed \proglang{C} function can run as much as one to two orders of magnitude faster than an equivalent \proglang{R} implementation. For many day-to-day applications, such gains are unlikely to be worth the considerable increase in implementation and maintenance costs associated with choosing \proglang{C} over \proglang{R}; however, they may prove vital when performing computationally demanding tasks such as Markov chain Monte Carlo simulation, large-graph computations, and small-N solutions for non-polynomial time problems (e.g., cycle counting). Another useful feature of the \proglang{C} API is its ability to make the complex data storage capabilities of \code{network} objects accessible to developers whose projects involve existing backend code, or developing packages such as \pkg{networkDynamic} which extend \pkg{network}'s functionality at the \proglang{C} level. Instead of performing data extraction on a \code{network} object and passing the result to the compiled routine, the \pkg{network} API allows for such routines to work with such objects directly. Finally, a third useful asset of the \pkg{network} API is the capacity it provides for generating user-transparent functionality which transcends what is feasible with \proglang{R}'s pass-by-value semantics. The use of compiled code to directly modify objects without copying has been fundamental to the functionality of the package since version 1.0, as can be gleaned from an examination of the package source code\footnote{The pass-by-value semantics are somewhat contrary to R's design philosophy and have been somewhat blocked in recent R versions. While the pass-by-value semantics functionality described is still operational, it must be implemented in less than optimal ways and my not offer the original speed gains.}. The mechanism by which the API is currently implemented is fairly simple. A shared header file (which must be included in the user's application) defines a series of macros which point to the package's internal routines. During program execution, a global registration function is used to map these macros to their internal symbols; following this, the macros may be called normally. Other then ensuring that the \pkg{network} library is loaded prior to invoking the registration function, no other measures are necessary. In particular, the calling routine does not have to be linked against the \pkg{network} library, although the aforementioned header/registration routines must be included at compile time.\footnote{Required files for the \pkg{network} API are available from \url{http://www.statnetproject.org/}.} In addition, \pkg{network} versions 1.11.1 and higher implement \proglang{R}'s template for registering native \proglang{C} routines \footnote{See the `Registering-native-routines' section of \url{http://cran.r-project.org/doc/manuals/r-release/R-exts.html }} so that packages may compile against \pkg{network}'s code by declaring a \code{LinkingTo: network} in the DESCRIPTION file. The listing of exported functions are in the file \code{src/Rinit.c}. \subsection[Using the network API]{Using the \pkg{network} API} To use the \pkg{network} API within one's own code, the following steps are necessary: \begin{enumerate} \item The required \pkg{network} header and function registration files must be added to the developer's source tree. \item The \pkg{network} header file must be included during compilation. \item The \code{netRegisterFunctions} function must be invoked at the entry point to any \proglang{C} program using the API. \item The \pkg{network} API functions must be used as required. \end{enumerate} The command \code{netRegisterFunctions} takes and returns no arguments, being invoked solely for its side effect. Although it must be called at each entry to the \proglang{C} backend (i.e., each invocation of \code{.Call} or \code{.External} from \proglang{R}), its effects persist until the calling routine exits. The API is designed for use with the \code{.Call} interface, although wrappers for conversion to \code{.External} are in principle possible. Object references are maintained through \code{SEXP} pointers, as is standard for \proglang{R}'s \proglang{C} language interface. Because references (rather than copies of the objects themselves) are passed to \proglang{C} via the interface, \proglang{C} routines may directly alter the objects with which they are called. \pkg{network} has many routines for creating and modifying \code{networks}, as well as for accessing object contents within compiled code. To illustrate the use of the network API in practical settings, we here provide a walk-through for a relatively simple (but non-trivial) example. Consider a \proglang{C} function which generates an undirected network from a homogeneous Bernoulli graph distribution, tagging each edge with random ``onset'' and ``termination'' times based on a piecewise-exponential process with fixed onset/termination hazards. Such a function might also keep track of the first and last edge times for each vertex (and for the network as a whole), storing these within the network object via appropriately named attributes. To implement our sample function, we begin with the standard header for a \code{.Call} function, which both takes and receives arguments of type \code{SEXP} (S-expression pointers). In this case, the parameters to be passed consist of an initialized \code{network} object, the probability of an edge between any two vertices, and the hazards for edge onset and termination (respectively). Note that we do not need to tell the function about properties such as network size, since it can determine these itself using the API's interface methods. \begin{Code} SEXP rnbernexp_R(SEXP g, SEXP ep, SEXP oh, SEXP th) /* C-Language code for a simple random dynamic network generator. Arguments are as follows: g - a pre-initialized network object ep - the edge probability parameter oh - the edge onset hazard parameter th - the edge termination hazard parameter */ { int n, i, w; double u, fet, let, *vfet, *vlet, ot, tt; SEXP tail, head, atl, atlnam, sot, stt, ec; /*Verify that we were called properly, and set things up*/ netRegisterFunctions(); if(!netIsNetwork(g)) error("rnbernexp_R must be called with a network object.\n"); if(netIsDir(g)) error("Network passed to rnbernexp_R should be undirected.\n"); n = netNetSize(g); PROTECT(ep = coerceVector(ep, REALSXP)); PROTECT(oh = coerceVector(oh, REALSXP)); PROTECT(th = coerceVector(th, REALSXP)); PROTECT(ec = allocVector(LGLSXP, 1)); LOGICAL(ec)[0] = 0; GetRNGstate(); /*Allocate memory for first/last edge time trackers*/ vfet = (double *)R_alloc(n, sizeof(double)); vlet = (double *)R_alloc(n, sizeof(double)); for(i = 0; i < n; i++) vfet[i] = vlet[i] = NA_REAL; fet = let = NA_REAL; \end{Code} In order to assure that all arguments are of the appropriate type, we employ a combination of verification and coercion. After registering the \pkg{network} API functions using \code{netRegisterFunctions}, we use the indicators \code{netIsNetwork} and \code{netIsDir} to verify that the \code{g} argument is indeed a \code{network} object, and that it is undirected. After verifying these conditions, we can use \code{netNetSize} to obtain the number of vertices in the network. This quantity is saved for further use. With the preliminaries out of the way, we are now in a position to draw edges. The algorithm used to generate the underlying graph is that of \cite{batagelj.brandes:pre:2005}, which scales well for sparse graphs (complexity is $\mathcal{O}(n+m)$). Edges themselves are added via the \code{netAddEdge} API function, which is analogous to \code{add.edge} in the \proglang{R} interface. Because we are operating directly on the network object, we must handle memory allocation ourselves: the \code{allocVector} calls in the following section are used to allocate memory for the head, tail, and attribute lists, and for the vector of attribute names. These are set accordingly, with the ``OnsetTime'' and ``TerminationTime'' attributes being created to store edge onsets and terminations, respectively. Once the edge elements are created, \code{netAddEdge} assures that they are placed within the \code{network} object; since \proglang{R}'s garbage collection mechanism protects these elements once they are linked to \code{g} (which is a protected object), we can subsequently remove them from the memory protection stack using \code{UNPROTECT}. \begin{Code} /*Draw the network information*/ w = -1; i = 1; while(i < n){ u = runif(0.0, 1.0); w += 1+ (int)floor(log(1.0 - u) / log(1.0 - REAL(ep)[0])); while((w >= i) && (i < n)){ w -= i; i++; } if(i < n){ /*Generate an edge*/ /*Draw and track timing information*/ ot = rexp(REAL(oh)[0]); tt = ot + rexp(REAL(th)[0]); fet = ((ISNA(fet)) || (ot < fet)) ? ot : fet; let = ((ISNA(let)) || (tt > let)) ? tt : let; vfet[i] = ((ISNA(vfet[i])) || (ot < vfet[i])) ? ot : vfet[i]; vlet[i] = ((ISNA(vlet[i])) || (tt > vlet[i])) ? tt : vlet[i]; /*Allocate memory for the new edge*/ PROTECT(tail = allocVector(INTSXP, 1)); /*Allocate head/tail*/ PROTECT(head = allocVector(INTSXP, 1)); INTEGER(tail)[0] = i + 1; INTEGER(head)[0] = w + 1; PROTECT(atl = allocVector(VECSXP, 2)); /*Allocate attributes*/ PROTECT(sot = allocVector(REALSXP, 1)); PROTECT(stt = allocVector(REALSXP, 1)); PROTECT(atlnam = allocVector(STRSXP, 2)); SET_STRING_ELT(atlnam, 0, mkChar("OnsetTime")); SET_STRING_ELT(atlnam, 1, mkChar("TerminationTime")); REAL(sot)[0] = ot; REAL(stt)[0] = tt; SET_VECTOR_ELT(atl, 0, sot); SET_VECTOR_ELT(atl, 1, stt); g = netAddEdge(g, tail, head, atlnam, atl, ec); /*Add the edge*/ UNPROTECT(6); } } \end{Code} At this point, all edges have been placed within the network. While we could stop here, it seems useful to first tabulate some basic meta-data regarding the network being produced. In particular, a function to analyze a network of this type would doubtless need to know the total time interval over which each vertex (and the network as a whole) is active. Via the \pkg{network} API, we can easily store this information in \code{g}'s network and vertex attribute lists before returning. To do this, we employ \code{netSetVertexAttrib} and \code{netSetNetAttrib}, API functions which are analogous to \code{set.vertex.attribute} and \code{set.network.attribute}. As with the case of edge addition, we must allocate memory for the attribute entry prior to installing it -- the \code{netSet*} routines pass references to their arguments, rather than copying them -- but these functions do handle the creation of attribute names from raw strings. After writing our metadata into the graph, we clear the protection stack and return the \proglang{R} object pointer. \begin{Code} /*Add network and vertex attributes*/ for(i = 0; i < n; i++){ PROTECT(sot = allocVector(REALSXP, 1)); PROTECT(stt = allocVector(REALSXP, 1)); REAL(sot)[0] = vfet[i]; REAL(stt)[0] = vlet[i]; g = netSetVertexAttrib(g, "FirstOnsetTime", sot, i + 1); g = netSetVertexAttrib(g, "LastTerminationTime", stt, i + 1); UNPROTECT(2); } PROTECT(sot = allocVector(REALSXP, 1)); PROTECT(stt = allocVector(REALSXP, 1)); REAL(sot)[0] = fet; REAL(stt)[0] = let; g = netSetNetAttrib(g, "FirstOnsetTime", sot); g = netSetNetAttrib(g, "LastTerminationTime", stt); /*Clear protection stack and return*/ PutRNGstate(); UNPROTECT(6); return g; } \end{Code} To use the \code{rnbernexp_R} function, it must be invoked from \proglang{R} using the \code{.Call} interface. A simple wrapper function (whose behavior is similar to \proglang{R}'s built-in random number generation routines) might look like the following: <<>>= rnbernexp <- function(n, nv, p = 0.5, onset.hazard = 1, termination.hazard = 1){ nets <- list() for(i in 1:n) nets[[i]] <- .Call("rnbernexp_R", network.initialize(nv, directed = FALSE), p, onset.hazard, termination.hazard, PACKAGE = "networkapi.example") if(i > 1) nets else nets[[1]] } @ In actual use, the \code{PACKAGE} setting would be changed to the name of the shared object file in which the \code{rnbernexp_R} symbol resides. (This file would need to be linked against the \code{networkapi} file, and dynamically loaded after \pkg{network} is in memory. Linking against the entire \pkg{network} library is not required, however.) Although the specific distribution simulated is too simplistic to serve as a very good model of social dynamics, it nevertheless illustrates how the \pkg{network} API can be used to efficiently simulate and store the results of non-trivial processes within compiled code. \section{Final comments} For several decades, tools for social network analysis were essentially isolated from those supporting conventional statistical analyses. A major reason for this isolation was the difficulty in manipulating -- or even representing -- relational data within standard statistical packages. In recent years, the emergence of flexible statistical computing environments such as \proglang{R} have helped to change this situation. Platforms like \proglang{R} allow for the creation of the complex data structures needed to represent rich relational data, while also facilitating the development of tools to make such structures accessible to the end user. The \pkg{network} package represents one attempt to leverage these capabilities in order to create a low-level infrastructure for the analysis of relational data. Together with packages like \pkg{sna}, \pkg{ergm}, and the rest of the \pkg{statnet} suite, it is hoped that \pkg{network} will provide a useful resource for scientists both inside and outside of the social network community. \section*{Acknowledgments} The author gratefully acknowledges the input of present and past \pkg{statnet} collaborators, including Mark Handcock, David Hunter, Daniel Westreich, Martina Morris, Steve Goodreau, Pavel Krivitsky, and Krista Gile. This paper is based upon work supported by National Institutes of Health award 5 R01 DA012831-05, subaward 918197, and by NSF award IIS-0331707. \begin{thebibliography}{} \bibitem[Batagelj \& Brandes(2005)]{batagelj.brandes:pre:2005} Batagelj V, Brandes U (2005). ``Efficient Generation of Large Random Networks.'' \emph{Physical Review E}, 71(3), 036113, 1-5. doi:10.1103/PhysRevE.71.036113. \bibitem[Batagelj(2007)]{pajek} Batagelj V, Mrvar A (2007). \emph{Pajek: Package for Large Network Analysis.} University of Ljubljana, Slovenia. URL \url{http://vlado.fmf.uni-lj.si/pub/networks/pajek/}. \bibitem[Butts(2002)]{butts:tr:2002} Butts CT (2002). ``Memory Structures for Relational Data in R: Classes and Interfaces.'' \emph{Unpublished manuscript}, University of California, Irvine. \bibitem[Butts(2007)]{sna} Butts CT (2007). \emph{sna: Tools for Social Network Analysis}. Statnet Project \url{http://statnetproject.org/}, Seattle, WA. R package version 1.5, URL \url{http://CRAN.R-project.org/package=sna}. \bibitem[Butts \& Carley(2005)]{butts.carley:cmot:2005} Butts CT, Carley KM (2005). ``Some Simple Algorithms for Structural Comparison.' \emph{Computational and Mathematical Organization Theory}, 11(4), 291-305. \bibitem[Butts, et al.(2007)]{network} Butts CT, Handcock MS, Hunter DR (2007). \emph{network: Classes for Relational Data}. Statnet Project \url{http://statnetproject.org/}, Seattle, WA. R package version 1.3, URL \url{http://CRAN.R-project.org/package=network}. \bibitem[Butts, et all.(2014)]{networkDynamic} Butts CT, Leslie-Cook A, Krivitsky P and Bender-deMoll S (2014). \emph{networkDynamic: Dynamic Extensions for Network Objects.} R package version 0.6.3. http://statnet.org URL \url{http://CRAN.R-project.org/package=networkDynamic} \bibitem[Carey, et al.(2007)]{carey.et.al:sw:2007} Carey VJ, Long L, Gentleman R (2007). \emph{RBGL: R Interface to Boost C++ Graph Library}. R package version 1.14.0, URL \url{http://www.bioconductor.org/}. \bibitem[Chambers(1998)]{chambers:bk:1998} Chambers JM (1998). \emph{Programming with Data}. Springer-Verlag, New York. ISBN 0-387- 98503-4. \bibitem[Csardi \& Nepusz(2006)]{gabor:sw:2007} Csardi G, Nepusz T (2006). ``The igraph Software Package for Complex Network Re- search.'' \emph{InterJournal, Complex Systems}, 1695. URL \url{http://www.interjournal.org/manuscript_abstract.php?361100992.} \bibitem[Doreian, et al.(2005)]{doreian.et.al:bk:2005} Doreian P, Batagelj V, Ferlioj A (2005). \emph{Generalized Blockmodeling}. Cambridge University Press, Cambridge. \bibitem[Drabek, et al.(1981)]{drabek.et.al:bk:1981} Drabek TE, Tamminga HL, Kilijanek TS, Adams CR (1981). \emph{Managing Multiorganizational Emergency Responses: Emergent Search and Rescue Networks in Natural Disaster and Remote Area Settings}. Number Monograph 33 in Program on Technology, Environment, and Man. Institute of Behavioral Sciences, University of Colorado, Boulder, CO. \bibitem[Fruchterman \& Reingold(1991)]{fruchterman.reingold:spae:1991} Fruchterman TMJ, Reingold EM (1991). ``Graph Drawing by Force-directed Placement.' \emph{Software -- Practice and Experience}, 21(11), 1129-1164. \bibitem[Gentleman, et al.(2007)]{gentleman.et.al:sw:2007} Gentleman R, Whalen E, Huber W, Falcon S (2007). \emph{graph: A Package to Handle Graph Data Structures}. R package version 1.14.2, URL \url{http://CRAN.R-project.org/package=graph.} \bibitem[Gentry, et al.(2007)]{gentry.et.al:sw:2007} Gentry J, Long L, Gentleman R, Falcon S (2007). \emph{Rgraphviz: Plotting Capabilities for R Graph Objects}. R package version 1.16.0, URL \url{http://CRAN.R-project.org/package=Rgraphviz}. \bibitem[Handcock, et al.(2003)]{statnet} Handcock MS, Hunter DR, Butts CT, Goodreau SM, Morris M (2003). \emph{statnet: Software Tools for the Statistical Modeling of Network Data}. Statnet Project \url{http://statnetproject.org/}, Seattle, WA. R package version 2.0, URL \url{http://CRAN. R-project.org/package=statnet}. \bibitem[Kamada\& Kawai(1989)]{kamada.kawai:ipl:1989} Kamada T, Kawai S (1989). ``An Algorithm for Drawing General Undirected Graphs.'' \emph{Information Processing Letters}, 31(1), 7-15. \bibitem[Killworth \& Bernard(1976)]{killworth.bernard:ho:1976} Killworth PD, Bernard HR (1976). ``Informant Accuracy in Social Network Data.'' \emph{Human Organization}, 35(8), 269-286. \bibitem[Koenker \& Ng(2007)]{koenker.ng:sw:2007} Koenker R, Ng P (2007). \emph{SparseM: Sparse Linear Algebra}. R package version 0.73, URL \url{http://CRAN.R-project.org/package=SparseM}. \bibitem[Krackhardt(1988)]{krackhardt:sn:1988} Krackhardt D (1988). ``Predicting with Networks: Nonparametric Multiple Regression Anal- yses of Dyadic Data.'' \emph{Social Networks}, 10, 359-382. \bibitem[Mayhew \& Levinger(1976)]{mayhew.levinger:ajs:1976} Mayhew BH, Levinger RL (1976). ``Size and Density of Interaction in Human Aggregates.'' \emph{American Journal of Sociology}, 82, 86-110. \bibitem[R Development Core Team(2007)]{R} R Development Core Team (2007). \emph{R: A Language and Environment for Statistical Computing}. R Foundation for Statistical Computing, Vienna, Austria. ISBN 3-900051-07-0, Version 2.6.1, URL \url{http://www.R-project.org/}. \bibitem[Venables \& Ripley(2000)]{venables.ripley:bk:2000} Venables WN, Ripley BD (2000). \emph{S Programming}. Springer-Verlag, New York. ISBN 0-387-98966-8. \bibitem[Venables \& Ripley(2002)]{venables.ripley:bk:2002} Venables WN, Ripley BD (2002). \emph{Modern Applied Statistics with S}. Springer-Verlag, New York, fourth edition. ISBN 0-387-95457-0. \bibitem[Wasserman \& Faust(1994)]{wass:faus1994} Wasserman SS, Faust K (1994). \emph{Social Network Analysis: Methods and Applications}. Structural Analysis in the Social Sciences. Cambridge University Press, Cambridge. \end{thebibliography} \end{document} network/COPYING0000644000176200001440000000162214057014734013004 0ustar liggesusers network Package for R - Classes for Relational Data Copyright (C) 2005-2021 Carter T. Butts, Mark S. Handcock, David R. Hunter, Martina Morris, and others (see DESCRIPTION). This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA network/R/0000755000176200001440000000000014060057170012144 5ustar liggesusersnetwork/R/zzz.R0000644000176200001440000000110414057014734013125 0ustar liggesusers###################################################################### # # zzz.R # # Written by Carter T. Butts . # # Last Modified 11/30/19 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # ###################################################################### .onAttach <- function(libname, pkgname){ #' @importFrom statnet.common statnetStartupMessage sm <- statnetStartupMessage("network", c("statnet","ergm","ergm.count","tergm"), TRUE) if(!is.null(sm)) packageStartupMessage(sm) } network/R/printsum.R0000644000176200001440000002745713737227152014200 0ustar liggesusers###################################################################### # # printsum.R # # Written by Carter T. Butts ; portions contributed by # David Hunter and Mark S. Handcock # . # # Last Modified 11/26/19 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains various routines for printing/summarizing # network class objects. # # Contents: # # print.network # print.summary.network # summary.character # summary.network # ###################################################################### # Printing for network class objects. # #' @rdname network #' @export print.network #' @export print.network<-function(x, matrix.type=which.matrix.type(x), mixingmatrices=FALSE, na.omit=TRUE, print.adj=FALSE, ...) { cat(" Network attributes:\n") for(i in 1:length(x$gal)){ if (names(x$gal)[i]=="n"){ attributeName<-"vertices" attributeValue<-x$gal[[i]] } else { attributeName<-names(x$gal)[i] attributeValue<-x$gal[[i]] } if(is.network(attributeValue)){ if(attributeName=="design"){ cat(" ",attributeName,"=\n") cat(" total missing =",network.edgecount(attributeValue),"\n") cat(" percent missing =",network.density(attributeValue),"\n") }else{ cat(" ",attributeName,":\n",sep="") if(is.discrete(attributeValue)){ assign(paste(" ",attributeName),attributeValue) print(table(get(paste(" ",attributeName)))) if(mixingmatrices){ cat("\n","mixing matrix for ",attributeName,":\n",sep="") print(mixingmatrix(x,attributeName)) } }else{ print(summary(attributeValue)) } } }else{ if(attributeName!="mnext"){ if(is.discrete(attributeValue)){ #assign(paste(" ",attributeName),attributeValue) #print(table(get(paste(" ",attributeName)))) print(table(attributeValue,dnn=paste(' ',attributeName,':',sep=''))) }else{ # for short attributes, just print out the values if(inherits(attributeValue,c("factor","character","numeric", "logical","integer","double","NULL","call","formula"))&&(length(attributeValue) < 10)){ # handle NULL case because cat won't print NULL if (is.null(attributeValue)){ cat(" ",attributeName,"= NULL\n") } else { if(is.call(attributeValue)) attributeValue <- deparse(attributeValue) cat(" ",attributeName,"=",attributeValue,"\n") } } else{ # special handling for classes where summary would give messy or non-useful output # don't print summary for net obs period or active attributes if (attributeName=='net.obs.period' || grepl('.active$',attributeName) ){ cat(" ",attributeName,": (not shown)\n", sep="") } else if (inherits(attributeValue,c("matrix"))){ cat(" ",attributeName,": ",nrow(attributeValue),"x",ncol(attributeValue)," matrix\n", sep="") } else { # default to printing out the summary for the attribute cat(" ",attributeName,":\n", sep="") if(is.call(attributeValue)){ # (unless it's a call like a formula) print(attributeValue) }else{ print(summary(attributeValue)) } } } } } } } cat(" total edges=",network.edgecount(x,na.omit=FALSE),"\n") cat(" missing edges=",network.naedgecount(x),"\n") cat(" non-missing edges=",network.edgecount(x,na.omit=TRUE),"\n") vna<-list.vertex.attributes(x) if(na.omit){ vna<-vna[vna!="na"] } if(length(vna)==0){ cat("\n","No vertex attributes","\n",sep="") }else{ cat("\n","Vertex attribute names:","\n") cat(" ",vna,"\n") } # Print list of edge attributes, but only if there are not very many edges # because list.edge.attributes is expensive on large nets if(length(x$mel)<=1000){ ena<-list.edge.attributes(x) if(na.omit){ ena<-ena[ena!='na'] } if(length(ena)==0){ cat("\n","No edge attributes","\n",sep="") }else{ cat("\n","Edge attribute names:","\n") cat(" ",ena,"\n") } } else { cat("\n","Edge attribute names not shown","\n") } #Print the adjacency structure, if desired if(print.adj){ if(is.multiplex(x)&&(matrix.type=="adjacency")) matrix.type<-"edgelist" if(is.hyper(x)) matrix.type<-"incidence" cat("\n",matrix.type,"matrix:\n") if(network.edgecount(x)>0){ mat<-as.matrix.network(x,matrix.type=matrix.type) attr(mat,"n")<-NULL #Get rid of any extra attributes attr(mat,"vnames")<-NULL attr(mat,"bipartite")<-NULL print(mat) }else cat("Empty Graph\n") } invisible(x) } #Print method for summary.character print.summary.character <- function(x, max.print=10, ...){ x<-table(x) nam<-names(x) x<-as.vector(x) names(x)<-nam if(length(x) <= max.print){ print(x) }else{ ord<-order(as.vector(x),decreasing=TRUE) cat(paste(" the ",max.print," most common values are:\n",sep="")) print(x[ord][1:max.print]) } invisible(x) } #Print method for summary.network #' @export print.summary.network #' @export print.summary.network<-function(x, ...){ #Pull any extra goodies from summary.network (stored in gal) na.omit<-x%n%"summary.na.omit" mixingmatrices<-x%n%"summary.mixingmatrices" print.adj<-x%n%"summary.print.adj" #Print the network-level attributes class(x)<-"network" cat("Network attributes:\n") for(i in 1:length(x$gal)){ if (names(x$gal)[i]=="n"){ attributeName<-"vertices" attributeValue<-x$gal[[i]] } else { attributeName<-names(x$gal)[i] attributeValue<-x$gal[[i]] } if(!(attributeName%in%c("mnext","summary.na.omit", "summary.mixingmatrices","summary.print.adj"))){ if(is.network(attributeValue)){ if(attributeName=="design"){ cat(" ",attributeName,"=\n") cat(" total missing = ",network.edgecount(attributeValue),"\n", sep="") cat(" percent missing =",network.density(attributeValue),"\n", sep="") }else{ cat(" ",attributeName,"=\n") print(attributeValue) } }else{ if(is.discrete(attributeValue)){ assign(paste(" ",attributeName),attributeValue) print(table(get(paste(" ",attributeName)))) if(mixingmatrices){ cat("\n","mixing matrix for ",attributeName,":\n",sep="") print(mixingmatrix(x,attributeName)) } }else{ if(inherits(attributeValue,c("factor","character","numeric", "logical","integer","double","call","formula"))&& (length(attributeValue) < 10)){ if(is.call(attributeValue)) attributeValue <- deparse(attributeValue) cat(" ",attributeName," = ",attributeValue,"\n",sep="") }else{ cat(" ",attributeName,":\n", sep="") if(is.call(attributeValue)){ print(attributeValue) }else{ print(summary(attributeValue)) } } } } } } cat(" total edges =",network.edgecount(x,na.omit=FALSE),"\n") cat(" missing edges =",network.naedgecount(x),"\n") cat(" non-missing edges =",network.edgecount(x,na.omit=TRUE),"\n") cat(" density =",network.density(x),"\n") #Print the network-level attributes van<-list.vertex.attributes(x) if(na.omit){ van<-van[van!="na"] } if(length(van)==0){ cat("\n","No vertex attributes","\n",sep="") }else{ cat("\nVertex attributes:\n") for (i in (1:length(van))){ if(van[i]=="vertex.names"){ cat(" vertex.names:\n") cat(" character valued attribute\n") cat(" ",sum(!is.na(network.vertex.names(x)))," valid vertex names\n",sep="") }else{ cat("\n ",van[i],":\n",sep="") aaval<-get.vertex.attribute(x,van[i],unlist=FALSE) aaclass<-unique(sapply(aaval,class)) aaclass<-aaclass[aaclass!="NULL"] if(length(aaclass)>1){ cat(" mixed class attribute\n") cat(" ",sum(!sapply(aaval,is.null)),"values\n") }else if(aaclass%in%c("logical","numeric","character","list")){ cat(" ",aaclass," valued attribute\n",sep="") aalen<-sapply(aaval,length) if(all(aalen<=1)&&(aaclass!="list")){ cat(" attribute summary:\n") print(summary(unlist(aaval))) if(is.discrete(unlist(aaval))&&mixingmatrices){ cat(" mixing matrix:\n") print(mixingmatrix(x,van[i])) } }else{ cat(" uneven attribute lengths; length distribution is\n") print(table(aalen)) } }else{ cat(" ",aaclass," valued attribute\n",sep="") cat(" ",length(aaval)," values\n",sep="") } } } } #Print the edge-level attributes ean <- list.edge.attributes(x) if(na.omit){ ean<-ean[ean!="na"] } if(length(ean)==0){ cat("\n","No edge attributes","\n",sep="") }else{ cat("\nEdge attributes:\n") for (i in (1:length(ean))){ cat("\n ",ean[i],":\n",sep="") eaval<-get.edge.attribute(x$mel,ean[i],unlist=FALSE) eaclass<-unique(sapply(eaval,class)) eaclass<-eaclass[eaclass!="NULL"] if(length(eaclass)>1){ cat(" mixed class attribute\n") cat(" ",sum(!sapply(eaval,is.null)),"values\n") }else if(eaclass%in%c("logical","numeric","character","list")){ cat(" ",eaclass," valued attribute\n",sep="") ealen<-sapply(eaval,length) if(all(ealen<=1)&&(eaclass!="list")){ cat(" attribute summary:\n") print(summary(unlist(eaval))) }else{ cat(" uneven attribute lengths; length distribution is\n") print(table(ealen)) } }else{ cat(" ",eaclass," valued attribute\n",sep="") cat(" ",length(eaval),"values\n",sep="") } } } #Print the adjacency structure if(print.adj){ matrix.type=which.matrix.type(x) if(is.multiplex(x)&&(matrix.type=="adjacency")) matrix.type<-"edgelist" if(is.hyper(x)) matrix.type<-"incidence" cat("\nNetwork ",matrix.type," matrix:\n",sep="") if(network.edgecount(x)>0){ mat<-as.matrix.network(x,matrix.type=matrix.type) attr(mat,"n")<-NULL #Get rid of any extra attributes attr(mat,"vnames")<-NULL attr(mat,"bipartite")<-NULL print(mat) }else cat("Empty Graph\n") } invisible(x) } #An internal routine to handle summaries of characters summary.character <- function(object, ...){ class(object)<-c("summary.character",class(object)) object } # Summaries of network objects # #' @rdname network #' @export summary.network #' @export summary.network<-function(object, na.omit=TRUE, mixingmatrices=FALSE, print.adj=TRUE, ...){ #Add printing parameters as network objects, and change the class object%n%"summary.na.omit"<-na.omit object%n%"summary.mixingmatrices"<-mixingmatrices object%n%"summary.print.adj"<-print.adj class(object)<-c("summary.network", class(object)) #Return the object object } network/R/access.R0000644000176200001440000023716114057075374013556 0ustar liggesusers###################################################################### # # access.R # # Written by Carter T. Butts ; portions contributed by # David Hunter and Mark S. Handcock # . # # Last Modified 06/06/21 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains various routines for accessing network class objects. # # Contents: # # add.edge # add.edges # add.vertices # delete.edge.attribute # delete.edges # delete.network.attribute # delete.vertex.attribute # delete.vertices # get.edge.attribute # get.edge.value # get.edgeIDs # get.edges # get.inducedSubgraph # get.network.attribute # get.neighborhood # get.vertex.attribute # has.loops # is.adjacent # is.bipartite # is.directed # is.hyper # is.multiplex # is.network # list.edge.attributes # list.network.attributes # list.vertex.attributes # network.dyadcount # network.edgecount # network.naedgecount # network.size # network.vertex.names # network.vertex.names<- # permute.vertexIDs # set.edge.attribute # set.edge.value # set.network.attribute # set.vertex.attribute # valid.eids # ###################################################################### #Add a single edge to a network object. # S3 method dispatch for add edge #' @name add.edges #' #' @title Add Edges to a Network Object #' #' @description Add one or more edges to an existing network object. #' #' @details The edge checking procedure is very slow, but should always be employed when #' debugging; without it, one cannot guarantee that the network state is #' consistent with network level variables (see #' \code{\link{network.indicators}}). For example, by default it is possible to #' add multiple edges to a pair of vertices. #' #' Edges can also be added/removed via the extraction/replacement operators. #' See the associated man page for details. #' #' @aliases add.edges.network add.edge.network #' @param x an object of class \code{network} #' @param tail for \code{add.edge}, a vector of vertex IDs reflecting the tail #' set for the edge to be added; for \code{add.edges}, a list of such vectors #' @param head for \code{add.edge}, a vector of vertex IDs reflecting the head #' set for the edge to be added; for \code{add.edges}, a list of such vectors #' @param names.eval for \code{add.edge}, an optional list of names for edge #' attributes; for \code{add.edges}, a list of length equal to the number of #' edges, with each element containing a list of names for the attributes of #' the corresponding edge #' @param vals.eval for \code{add.edge}, an optional list of edge attribute #' values (matching \code{names.eval}); for \code{add.edges}, a list of such #' lists #' @param edge.check logical; should we perform (computationally expensive) #' tests to check for the legality of submitted edges? #' @param ... additional arguments #' @return Invisibly, \code{add.edge} and \code{add.edges} return pointers to #' their modified arguments; both functions modify their arguments in place.. #' @note \code{add.edges} and \code{add.edge} were converted to an S3 generic #' funtions in version 1.9, so they actually call \code{add.edges.network} and #' \code{add.edge.network} by default, and may call other versions depending on #' context (i.e. when called with a \code{networkDynamic} object). #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network}}, \code{\link{add.vertices}}, #' \code{\link{network.extraction}}, \code{\link{delete.edges}}, #' \code{\link{network.edgelist}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @keywords classes graphs #' @examples #' #' #Initialize a small, empty network #' g<-network.initialize(3) #' #' #Add an edge #' add.edge(g,1,2) #' g #' #' #Can also add edges using the extraction/replacement operators #' #note that replacement operators are much slower than add.edges() #' g[,3]<-1 #' g[,] #' #' #Add multiple edges with attributes to a network #' #' # pretend we just loaded in this data.frame from a file #' # Note: network.edgelist() may be simpler for this case #' elData<-data.frame( #' from_id=c("1","2","3","1","3","1","2"), #' to_id=c("1", "1", "1", "2", "2", "3", "3"), #' myEdgeWeight=c(1, 2, 1, 2, 5, 3, 9.5), #' someLetters=c("B", "W", "L", "Z", "P", "Q", "E"), #' edgeCols=c("red","green","blue","orange","pink","brown","gray"), #' stringsAsFactors=FALSE #' ) #' #' valueNet<-network.initialize(3,loops=TRUE) #' #' add.edges(valueNet,elData[,1],elData[,2], #' names.eval=rep(list(list("myEdgeWeight","someLetters","edgeCols")),nrow(elData)), #' vals.eval=lapply(1:nrow(elData),function(r){as.list(elData[r,3:5])})) #' #' list.edge.attributes(valueNet) #' #' #' @export add.edge<-function(x, tail, head, names.eval=NULL, vals.eval=NULL, edge.check=FALSE, ...){ xn<-substitute(x) UseMethod("add.edge") if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } invisible(x) } #' @export add.edge.network #' @export add.edge.network<-function(x, tail, head, names.eval=NULL, vals.eval=NULL, edge.check=FALSE, ...){ xn<-substitute(x) if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } x<-.Call(addEdge_R,x,tail,head,names.eval,vals.eval,edge.check) invisible(x) } # S3 method dispatch for add.edges #' @rdname add.edges #' @export add.edges add.edges<-function(x, tail, head, names.eval=NULL, vals.eval=NULL, ...){ xn<-substitute(x) UseMethod("add.edges") if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } invisible(x) } # Add multiple edges to network x. Tail must be a list, each element of # which is the tail set for a given edge (ditto for head). If edge values # are provided, they must be given similarly as lists of lists. #' @export add.edges.network #' @export add.edges.network<-function(x, tail, head, names.eval=NULL, vals.eval=NULL, ...){ #Ensure that the inputs are set up appropriately if(!is.list(tail)) tail<-as.list(tail) if(!is.list(head)) head<-as.list(rep(head,length=length(tail))) if(is.null(names.eval)) names.eval<-replicate(length(tail),NULL) else if(!is.list(names.eval)) names.eval<-as.list(rep(names.eval,length=length(tail))) if(is.null(vals.eval)) vals.eval<-replicate(length(tail),NULL) else if(!is.list(vals.eval)) vals.eval<-as.list(rep(vals.eval,length=length(names.eval))) if(length(unique(c(length(tail),length(head),length(names.eval), length(vals.eval))))>1) stop("head, tail, names.eval and vals.eval lists passed to add.edges must be of the same length!\n") edge.check<-list(...)$edge.check if(is.null(edge.check)) edge.check<-FALSE #Pass the inputs to the C side xn<-substitute(x) x<-.Call(addEdges_R,x,tail,head,names.eval,vals.eval,edge.check) if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } invisible(x) } # S3 method dispatch for add.vertices #' Add Vertices to an Existing Network #' #' \code{add.vertices} adds a specified number of vertices to an existing #' network; if desired, attributes for the new vertices may be specified as #' well. #' #' New vertices are generally appended to the end of the network (i.e., their #' vertex IDs begin with \code{network.size(x)} an count upward). The one #' exception to this rule is when \code{x} is bipartite and #' \code{last.mode==FALSE}. In this case, new vertices are added to the end of #' the first mode, with existing second-mode vertices being permuted upward in #' ID. (\code{x}'s \code{bipartite} attribute is adjusted accordingly.) #' #' Note that the attribute format used here is based on the internal #' (vertex-wise) storage method, as opposed to the attribute-wise format used #' by \code{\link{network}}. Specifically, \code{vattr} should be a list with #' one entry per new vertex, the ith element of which should be a list with an #' element for every attribute of the ith vertex. (If the required \code{na} #' attribute is not given, it will be automatically created.) #' #' @aliases add.vertices.network #' @param x an object of class \code{network} #' @param nv the number of vertices to add #' @param vattr optionally, a list of attributes with one entry per new vertex #' @param last.mode logical; should the new vertices be added to the last #' (rather than the first) mode of a bipartite network? #' @param ... possible additional arguments to add.vertices #' @return Invisibly, a pointer to the updated \code{network} object; #' \code{add.vertices} modifies its argument in place. #' @note \code{add.vertices} was converted to an S3 generic funtion in version #' 1.9, so it actually calls \code{add.vertices.network} by default and may #' call other versions depending on context (i.e. when called with a #' \code{networkDynamic} object). #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network}}, \code{\link{get.vertex.attribute}}, #' \code{\link{set.vertex.attribute}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @keywords classes graphs #' @examples #' #' #Initialize a network object #' g<-network.initialize(5) #' g #' #' #Add five more vertices #' add.vertices(g,5) #' g #' #' #Create two more, with attributes #' vat<-replicate(2,list(is.added=TRUE,num.added=2),simplify=FALSE) #' add.vertices(g,2,vattr=vat) #' g%v%"is.added" #Values are only present for the new cases #' g%v%"num.added" #' #' #Add to a bipartite network #' bip <-network.initialize(5,bipartite=3) #' get.network.attribute(bip,'bipartite') # how many vertices in first mode? #' add.vertices(bip,3,last.mode=FALSE) #' get.network.attribute(bip,'bipartite') #' #' @export add.vertices add.vertices<-function(x, nv, vattr=NULL, last.mode=TRUE, ...){ xn<-substitute(x) UseMethod("add.vertices") if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } invisible(x) } # Add nv vertices to network x. Vertex attributes (in addition to those which # are required) are to be provided in vattr; vattr must be a list containing # nv elements, each of which is equal to the desired val[i] entry. #' @export add.vertices.network #' @export add.vertices.network<-function(x, nv, vattr=NULL, last.mode=TRUE, ...){ #Check to be sure we were called with a network if(!is.network(x)) stop("add.vertices requires an argument of class network.\n") #Check the vertex attributes, to be sure that they are legal if(!is.null(vattr)){ if(is.list(vattr)) vattr<-rep(vattr,length=nv) else vattr<-as.list(rep(vattr,length=nv)) } #Perform the addition xn<-substitute(x) if(nv>0){ if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } if(last.mode||(!is.bipartite(x))){ x<-.Call(addVertices_R,x,nv,vattr) }else{ nr<-nv nc<-0 nnew<-nr+nc nold<-network.size(x) bip<-x%n%"bipartite" x<-.Call(addVertices_R, x, nv, vattr) if(nr>0){ if(bip>0) orow<-1:bip else orow<-NULL if(nold-bip>0) ocol<-(bip+1):nold else ocol<-NULL ncol<-NULL nrow<-(nold+nnew-nr+1):(nold+nnew) permute.vertexIDs(x,c(orow,nrow,ocol,ncol)) set.network.attribute(x,"bipartite",bip+nr) } } } invisible(x) } # Remove all instances of the specified attribute(s) from the edge set # #' @name attribute.methods #' #' @title Attribute Interface Methods for the Network Class #' #' @description These methods get, set, list, and delete attributes at the #' network, edge, and vertex level. #' #' @details The \code{list.attributes} functions return the names of all edge, #' network, or vertex attributes (respectively) in the network. All #' attributes need not be defined for all elements; the union of all extant #' attributes for the respective element type is returned. #' #' The \code{get.attribute} functions look for an edge, network, or vertex #' attribute (respectively) with the name \code{attrname}, returning its #' values. Note that, to retrieve an edge attribute from all edges within #' a network \code{x}, \code{x$mel} should be used as the first argument to #' \code{get.edge.attribute}; \code{get.edge.value} is a convenience function #' which does this automatically. As of v1.7.2, if a \code{network} object is #' passed to \code{get.edge.attribute} it will automatically call #' \code{get.edge.value} instead of returning NULL. When the parameters #' \code{na.omit}, or \code{deleted.edges.omit} are used, the position index #' of the attribute values returned will not correspond to the vertex/edge #' id. To preserved backward compatibility, if the edge attribute #' \code{attrname} does not exist for any edge, \code{get.edge.attribute} #' will still return \code{NULL} even if \code{null.na=TRUE} #' #' \code{network.vertex.names} is a convenience function to extract the #' \code{"vertex.names"} attribute from all vertices. #' #' The \code{set.attribute} functions allow one to set the values of edge, #' network, or vertex attributes. \code{set.edge.value} is a convenience #' function which allows edge attributes to be given in adjacency matrix #' form, and the assignment form of \code{network.vertex.names} is likewise #' a convenient front-end to \code{set.vertex.attribute} for vertex names. #' The \code{delete.attribute} functions, by contrast, remove the named #' attribute from the network, from all edges, or from all vertices (as #' appropriate). If \code{attrname} is a vector of attribute names, each #' will be removed in turn. These functions modify their arguments in place, #' although a pointer to the modified object is also (invisibly) returned. #' #' Additional practical example of how to load and attach attributes are on the #' \code{\link{loading.attributes}} page. #' #' Some attribute assignment/extraction can be performed conveniently through #' the various extraction/replacement operators, although they may be less #' efficient. See the associated man page for details. #' #' #' @param x an object of class \code{network}, or a list of edges #' (possibly \code{network$mel}) in \code{get.edge.attribute}. #' @param el Deprecated; use \code{x} instead. #' @param attrname the name of the attribute to get or set. #' @param unlist logical; should retrieved attribute values be #' \code{\link{unlist}}ed prior to being returned? #' @param na.omit logical; should retrieved attribute values corresponding to #' vertices/edges marked as 'missing' be removed? #' @param deleted.edges.omit logical: should the elements corresponding to #' deleted edges be removed? #' @param null.na logical; should \code{NULL} values (corresponding to vertices #' or edges with no values set for the attribute) be replaced with \code{NA}s #' in output? #' @param value values of the attribute to be set; these should be in #' \code{vector} or \code{list} form for the \code{edge} and \code{vertex} #' cases, or \code{matrix} form for \code{set.edge.value}. #' @param e IDs for the edges whose attributes are to be altered. #' @param v IDs for the vertices whose attributes are to be altered. #' @param ... additional arguments #' #' @return For the \code{list.attributes} methods, a vector containing #' attribute names. For the \code{get.attribute} methods, a list containing #' the values of the attribute in question (or simply the value itself, for #' \code{get.network.attribute}). For the \code{set.attribute} and #' \code{delete.attribute} methods, a pointer to the updated \code{network} #' object. #' @note As of version 1.9 the \code{set.vertex.attribute} function can accept #' and modify multiple attributes in a single call to improve efficiency. #' For this case \code{attrname} can be a list or vector of attribute names #' and \code{value} is a list of values corresponding to the elements of #' \code{attrname} (can also be a list of lists of values if elements in v #' should have different values). #' @seealso \code{\link{loading.attributes}},\code{\link{network}}, #' \code{\link{as.network.matrix}}, \code{\link{as.sociomatrix}}, #' \code{\link{as.matrix.network}}, \code{\link{network.extraction}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @author Carter T. Butts \email{buttsc@uci.edu} #' @examples #' #Create a network with three edges #' m<-matrix(0,3,3) #' m[1,2]<-1; m[2,3]<-1; m[3,1]<-1 #' g<-network(m) #' #' #Create a matrix of values corresponding to edges #' mm<-m #' mm[1,2]<-7; mm[2,3]<-4; mm[3,1]<-2 #' #' #Assign some attributes #' set.edge.attribute(g,"myeval",3:5) #' set.edge.value(g,"myeval2",mm) #' set.network.attribute(g,"mygval","boo") #' set.vertex.attribute(g,"myvval",letters[1:3]) #' network.vertex.names(g) <- LETTERS[1:10] #' #' #List the attributes #' list.edge.attributes(g) #' list.network.attributes(g) #' list.vertex.attributes(g) #' #' #Retrieve the attributes #' get.edge.attribute(g$mel,"myeval") #Note the first argument! #' get.edge.value(g,"myeval") #Another way to do this #' get.edge.attribute(g$mel,"myeval2") #' get.network.attribute(g,"mygval") #' get.vertex.attribute(g,"myvval") #' network.vertex.names(g) #' #' #Purge the attributes #' delete.edge.attribute(g,"myeval") #' delete.edge.attribute(g,"myeval2") #' delete.network.attribute(g,"mygval") #' delete.vertex.attribute(g,"myvval") #' #' #Verify that the attributes are gone #' list.edge.attributes(g) #' list.network.attributes(g) #' list.vertex.attributes(g) #' #' #Note that we can do similar things using operators #' g %n% "mygval" <- "boo" #Set attributes, as above #' g %v% "myvval" <- letters[1:3] #' g %e% "myeval" <- mm #' g[,,names.eval="myeval"] <- mm #Another way to do this #' g %n% "mygval" #Retrieve the attributes #' g %v% "myvval" #' g %e% "mevval" #' as.sociomatrix(g,"myeval") # Or like this #' #' @keywords classes graphs #' @export delete.edge.attribute delete.edge.attribute <- function(x, attrname, ...) { UseMethod("delete.edge.attribute") } #' @rdname attribute.methods #' @export delete.edge.attribute.network <- function(x, attrname, ...) { #Remove the edges xn<-substitute(x) x<-.Call(deleteEdgeAttribute_R,x,attrname) if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } invisible(x) } # Remove specified edges from the network. # #' @name deletion.methods #' #' @title Remove Elements from a Network Object #' #' @description \code{delete.edges} removes one or more edges (specified by #' their internal ID numbers) from a network; \code{delete.vertices} #' performs the same task for vertices (removing all associated edges in #' the process). #' #' @details Note that an edge's ID number corresponds to its order within #' \code{x$mel}. To determine edge IDs, see \code{\link{get.edgeIDs}}. #' Likewise, vertex ID numbers reflect the order with which vertices are #' listed internally (e.g., the order of \code{x$oel} and \code{x$iel}, or #' that used by \code{as.matrix.network.adjacency}). When vertices are #' removed from a network, all edges having those vertices as endpoints are #' removed as well. When edges are removed, the remaining edge ids are NOT #' permuted and \code{NULL} elements will be left on the list of edges, which #' may complicate some functions that require eids (such as #' \code{\link{set.edge.attribute}}). The function \code{\link{valid.eids}} #' provides a means to determine the set of valid (non-NULL) edge ids. #' #' Edges can also be added/removed via the extraction/replacement operators. #' See the associated man page for details. #' #' @param x an object of class \code{network}. #' @param eid a vector of edge IDs. #' @param vid a vector of vertex IDs. #' #' @return Invisibly, a pointer to the updated network; these functions modify #' their arguments in place. #' #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @author Carter T. Butts \email{buttsc@uci.edu} #' #' @seealso \code{\link{get.edgeIDs}}, \code{\link{network.extraction}}, #' \code{\link{valid.eids}} #' @examples #' #Create a network with three edges #' m<-matrix(0,3,3) #' m[1,2]<-1; m[2,3]<-1; m[3,1]<-1 #' g<-network(m) #' #' as.matrix.network(g) #' delete.edges(g,2) #Remove an edge #' as.matrix.network(g) #' delete.vertices(g,2) #Remove a vertex #' as.matrix.network(g) #' #' #Can also remove edges using extraction/replacement operators #' g<-network(m) #' g[1,2]<-0 #Remove an edge #' g[,] #' g[,]<-0 #Remove all edges #' g[,] #' #' @keywords classes graphs #' @export delete.edges<-function(x,eid){ #Check to be sure we were called with a network if(!is.network(x)) stop("delete.edges requires an argument of class network.") xn<-substitute(x) if(length(eid)>0){ #Perform a sanity check if((min(eid)<1)|(max(eid)>length(x$mel))) stop("Illegal edge in delete.edges.\n") #Remove the edges x<-.Call(deleteEdges_R,x,eid) if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } } invisible(x) } # Remove the specified network-level attribute(s) # #' @rdname attribute.methods #' @export delete.network.attribute <- function(x, attrname, ...) { UseMethod("delete.network.attribute") } #' @rdname attribute.methods #' @export delete.network.attribute.network <- function(x, attrname, ...){ #Remove the edges xn<-substitute(x) x<-.Call(deleteNetworkAttribute_R,x,attrname) if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } invisible(x) } # Remove all instances of the specified attribute(s) from the vertex set # #' @rdname attribute.methods #' @export delete.vertex.attribute <- function(x, attrname, ...) { UseMethod("delete.vertex.attribute") } #' @rdname attribute.methods #' @export delete.vertex.attribute.network <- function(x, attrname, ...) { #Remove the attribute (or do nothing, if there are no vertices) if(network.size(x)>0){ xn<-substitute(x) x<-.Call(deleteVertexAttribute_R,x,attrname) if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } } invisible(x) } # Remove specified vertices (and associated edges) from the network. # #' @rdname deletion.methods #' @export delete.vertices delete.vertices<-function(x,vid){ #Check to be sure we were called with a network if(!is.network(x)) stop("delete.vertices requires an argument of class network.") #Remove any vids which are out of bounds vid<-vid[(vid>0)&(vid<=network.size(x))] #Do the deed, if still needed xn<-substitute(x) if(length(vid)>0){ if(is.bipartite(x)){ #If bipartite, might need to adjust mode 1 count m1v<-get.network.attribute(x,"bipartite") #How many mode 1 verts? set.network.attribute(x,"bipartite",m1v-sum(vid<=m1v)) } x<-.Call(deleteVertices_R,x,vid) if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } } invisible(x) } # Retrieve a specified edge attribute from edge list or network x. The attribute # is returned as a list, unless unlist is TRUE. # if deleted.edges.omit is TRUE, then only attribute values on existing (non-null) edges will be returned. # if na.omit is TRUE, than values corresponding to 'missing' edges (edges with attribute 'na' set to TRUE) should be ommited. (NULL edgs count as not-missing) # If null.na is TRUE, then values corresponding to edges for which the attribute name was never set will be set to NA. Otherwise, they will be NULL, which means they will be included when unlist=TRUE # #' @rdname attribute.methods #' @export get.edge.attribute <- function(x, ..., el) { if(!missing(el)) { warning("Argument ", sQuote("el"), " to ", sQuote("get.edge.attribute"), " is deprecated and will be removed in a future version. Use ", sQuote("x"), " instead.") UseMethod("get.edge.attribute", object = el) } else { UseMethod("get.edge.attribute", object = x) } } #' @rdname attribute.methods #' @export get.edge.attribute.network <- function(x, attrname, unlist=TRUE, na.omit=FALSE, null.na=FALSE, deleted.edges.omit=FALSE, ..., el) { if(!missing(el)) x <- el if (is.network(x)) x <- x$mel if (!is.list(x)) stop("x must be a network object or a list.") if (!is.character(attrname)) stop("attrname must be a character vector.") if (!is.logical(unlist) || !is.logical(na.omit) || !is.logical(null.na) || !is.logical(deleted.edges.omit)) stop("na.omit, null.na, deleted.edges.omit must be a logical vector.") edges <- .Call(getEdgeAttribute_R,x,attrname,na.omit,null.na,deleted.edges.omit) if(unlist) unlist(edges) else edges } #' @rdname attribute.methods #' @export get.edge.attribute.list <- get.edge.attribute.network # Retrieve a specified edge attribute from all edges in x. # #' @rdname attribute.methods #' @export get.edge.value <- function(x, ...) { UseMethod("get.edge.value") } #' @rdname attribute.methods #' @export get.edge.value.network <- function(x, attrname, unlist=TRUE, na.omit=FALSE, null.na=FALSE, deleted.edges.omit=FALSE, ...){ get.edge.attribute(x,attrname,unlist,na.omit,null.na,deleted.edges.omit) } #' @rdname attribute.methods #' @export get.edge.value.list <- get.edge.value.network # Retrieve the ID numbers for all edges incident on v, in network x. # Outgoing or incoming edges are specified by neighborhood, while na.omit # indicates whether or not missing edges should be omitted. The return value # is a vector of edge IDs. # #' @name get.edges #' #' @title Retrieve Edges or Edge IDs Associated with a Given Vertex #' #' @description \code{get.edges} retrieves a list of edges incident on a given vertex; #' \code{get.edgeIDs} returns the internal identifiers for those edges, #' instead. Both allow edges to be selected based on vertex neighborhood and #' (optionally) an additional endpoint. #' #' @details By default, \code{get.edges} returns all out-, in-, or out- and in-edges #' containing \code{v}. \code{get.edgeIDs} is identical, save in its return #' value, as it returns only the ids of the edges. Specifying a vertex in #' \code{alter} causes these edges to be further selected such that alter must #' also belong to the edge -- this can be used to extract edges between two #' particular vertices. Omission of missing edges is accomplished via #' \code{na.omit}. Note that for multiplex networks, multiple edges or edge #' ids can be returned. #' #' The function \code{get.dyads.eids} simplifies the process of looking up the #' edge ids associated with a set of 'dyads' (tail and head vertex ids) for #' edges. It only is intended for working with non-multiplex networks and will #' return a warning and \code{NA} value for any dyads that correspond to #' multiple edges. The value \code{numeric(0)} will be returned for any dyads #' that do not have a corresponding edge. #' #' @param x an object of class \code{network} #' @param v a vertex ID #' @param alter optionally, the ID of another vertex #' @param neighborhood an indicator for whether we are interested in in-edges, #' out-edges, or both (relative to \code{v}). defaults to \code{'combined'} for #' undirected networks #' @param na.omit logical; should we omit missing edges? #' @param tails a vector of vertex ID for the 'tails' (v) side of the dyad #' @param heads a vector of vertex ID for the 'heads' (alter) side of the dyad #' @return For \code{get.edges}, a list of edges. For \code{get.edgeIDs}, a #' vector of edge ID numbers. For \code{get.dyads.eids}, a list of edge IDs #' corresponding to the dyads defined by the vertex ids in \code{tails} and #' \code{heads} #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{get.neighborhood}}, \code{\link{valid.eids}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @keywords classes graphs #' @examples #' #' #Create a network with three edges #' m<-matrix(0,3,3) #' m[1,2]<-1; m[2,3]<-1; m[3,1]<-1 #' g<-network(m) #' #' get.edges(g,1,neighborhood="out") #' get.edgeIDs(g,1,neighborhood="in") #' #' @export get.edgeIDs get.edgeIDs<-function(x, v, alter=NULL, neighborhood=c("out","in","combined"), na.omit=TRUE){ #Check to be sure we were called with a network if(!is.network(x)) stop("get.edgeIDs requires an argument of class network.") #Do some reality checking n<-network.size(x) if((v<1)||(v>n)) return(numeric(0)) if((!is.null(alter))&&((alter<1)||(alter>n))) return(numeric(0)) #Retrieve the edges if(!is.directed(x)) neighborhood="combined" #If undirected, out==in==combined else neighborhood=match.arg(neighborhood) #Do the deed .Call(getEdgeIDs_R,x,v,alter,neighborhood,na.omit) } # Retrieve all edges incident on v, in network x. Outgoing or incoming # edges are specified by neighborhood, while na.omit indicates whether # or not missing edges should be omitted. The return value is a list of # edges. # #' @rdname get.edges #' @export get.edges get.edges<-function(x, v, alter=NULL, neighborhood=c("out","in","combined"), na.omit=TRUE){ #Check to be sure we were called with a network if(!is.network(x)) stop("get.edges requires an argument of class network.") #Do some reality checking n<-network.size(x) if((v<1)||(v>n)) return(list()) if((!is.null(alter))&&((alter<1)||(alter>n))) return(list()) #Retrieve the edges if(!is.directed(x)) neighborhood="combined" #If undirected, out==in==combined else neighborhood=match.arg(neighborhood) #Do the deed .Call(getEdges_R,x,v,alter,neighborhood,na.omit) } # get the the edge ids associated with a set of dayds # as defined by a vector of tails and heads vertex ids #' @rdname get.edges #' @export get.dyads.eids get.dyads.eids<-function(x,tails,heads,neighborhood = c("out", "in", "combined")){ if(length(tails)!=length(heads)){ stop('heads and tails vectors must be the same length for get.dyads.eids') } if (any(heads>network.size(x) | heads<1) | any(tails>network.size(x) | tails<1)){ stop('invalid vertex id in heads or tails vector') } neighborhood<-match.arg(neighborhood) if (!is.directed(x)){ neighborhood = "combined" } lapply(seq_along(tails),function(e){ eid<-get.edgeIDs(x,v = tails[e],alter=heads[e],neighborhood=neighborhood) if(length(eid)>1){ eid<-NA warning('get.dyads.eids found multiple edge ids for dyad ',tails[e],',',heads[e],' NA will be returned') } eid }) } # Given a network and a set of vertices, return the subgraph induced by those # vertices (preserving all associated metadata); if given two such sets, # return the edge cut (along with the associated vertices and meta-data) as # a bipartite network. # #' Retrieve Induced Subgraphs and Cuts #' #' Given a set of vertex IDs, \code{get.inducedSubgraph} returns the subgraph #' induced by the specified vertices (i.e., the vertices and all associated #' edges). Optionally, passing a second set of alters returns the cut from the #' first to the second set (i.e., all edges passing between the sets), along #' with the associated endpoints. Alternatively, passing in a vector of edge #' ids will induce a subgraph containing the specified edges and their incident #' vertices. In all cases, the result is returned as a network object, with #' all attributes of the selected edges and/or vertices (and any network #' attributes) preserved. #' #' For \code{get.inducedSubgraph}, \code{v} can be a vector of vertex IDs. If #' \code{alter=NULL}, the subgraph induced by these vertices is returned. #' Calling \code{\%s\%} with a single vector of vertices has an identical effect. #' #' Where \code{alters} is specified, it must be a vector of IDs disjoint with #' \code{v}. Where both are given, the edges spanning \code{v} and #' \code{alters} are returned, along with the vertices in question. #' (Technically, only the edges really constitute the \dQuote{cut,} but the #' vertices are included as well.) The same result can be obtained with the #' \code{\%s\%} operator by passing a two-element list on the right hand side; #' the first element is then interpreted as \code{v}, and the second as #' \code{alters}. #' #' When \code{eid} is specified, the \code{v} and \code{alters} argument will #' be ignored and the subgraph induced by the specified edges and their #' incident vertices will be returned. #' #' Any network, vertex, or edge attributes for the selected network elements #' are retained (although features such as vertex IDs and the network size will #' typically change). These are copies of the elements in the original #' network, which is not altered by this function. #' #' @param x an object of class \code{network}. #' @param v a vector of vertex IDs, or, for \code{\%s\%}, optionally a list containing two disjoint vectors of vertex IDs (see below). #' #' @param alters optionally, a second vector of vertex IDs. Must be disjoint #' with \code{v}. #' #' @param eid optionally, a numeric vector of valid edge ids in \code{x} that #' should be retained (cannot be used with \code{v} or \code{alter}) #' #' @return A \code{\link{network}} object containing the induced subgraph. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network}}, \code{\link{network.extraction}} #' @keywords graphs manip #' @examples #' #' #Load the Drabek et al. EMON data #' data(emon) #' #' #For the Mt. St. Helens, EMON, several types of organizations are present: #' type<-emon$MtStHelens %v% "Sponsorship" #' #' #Plot interactions among the state organizations #' plot(emon$MtStHelens %s% which(type=="State"), displaylabels=TRUE) #' #' #Plot state/federal interactions #' plot(emon$MtStHelens %s% list(which(type=="State"), #' which(type=="Federal")), displaylabels=TRUE) #' #' #Plot state interactions with everyone else #' plot(emon$MtStHelens %s% list(which(type=="State"), #' which(type!="State")), displaylabels=TRUE) #' #' # plot only interactions with frequency of 2 #' subG2<-get.inducedSubgraph(emon$MtStHelens, #' eid=which(emon$MtStHelens%e%'Frequency'==2)) #' plot(subG2,edge.label='Frequency') #' #' #' @export get.inducedSubgraph get.inducedSubgraph<-function(x, v, alters=NULL, eid=NULL){ #Check to be sure we were called with a network if(!is.network(x)) stop("get.inducedSubgraph requires an argument of class network.") #Do some reality checking n<-network.size(x) # are we doing this via eids, or v and alters if (is.null(eid)){ # do checks for v and alters if((length(v)<1)||any(is.na(v))||any(v<1)||any(v>n)) stop("Illegal vertex selection in get.inducedSubgraph") if(!is.null(alters)){ if((length(alters)<1)||any(is.na(alters))||any(alters<1)||any(alters>n)|| any(alters%in%v)) stop("Illegal vertex selection (alters) in get.inducedSubgraph") } if (!is.null(eid)){ warning('eid argument to get.inducedSubgraph ignored when using v or alter argument') } } else { # do checks for eids if (!is.numeric(eid)){ stop('eid must be a numeric vector of edge ids') } if (!missing(v)){ warning('v argument to get.inducedSubgraph ignored when using eid argument') } if (!is.null(alters)){ warning('alters argument to get.inducedSubgraph ignored when using eid argument') } # check that eids are valid if (any(!eid%in%valid.eids(x))){ stop('eid argument contains non-valid edge ids') } } #Start by making a copy of our target network (yes, this can be wasteful) #TODO: in most cases, probably faster to create a new network and only copy over what is needed newNet<-network.copy(x) if (is.null(eid)){ # using v and alter #Now, strip out what is needed, and/or permute in the two-mode case if(is.null(alters)){ #Simple case delete.vertices(newNet,(1:n)[-v]) #Get rid of everyone else }else{ #Really an edge cut, but w/vertices nv<-length(v) na<-length(alters) newids<-sort(c(v,alters)) newv<-match(v,newids) newalt<-match(alters,newids) delete.vertices(newNet,(1:n)[-c(v,alters)]) #Get rid of everyone else permute.vertexIDs(newNet,c(newv,newalt)) #Put the new vertices first #Remove within-group edges for(i in 1:nv) for(j in (i:nv)[-1]){ torem<-get.edgeIDs(newNet,i,alter=j,neighborhood="combined",na.omit=FALSE) if(length(torem)>0) delete.edges(newNet,torem) } for(i in (nv+1):(nv+na)) for(j in (i:(nv+na))[-1]){ torem<-get.edgeIDs(newNet,i,alter=j,neighborhood="combined",na.omit=FALSE) if(length(torem)>0) delete.edges(newNet,torem) } newNet%n%"bipartite"<-nv #Set bipartite attribute } } else { # using eids instead of v and alters # delete all the edges not in eid removeEid<-setdiff(valid.eids(newNet),eid) delete.edges(newNet,removeEid) # find the set of vertices incident on the remaining edges v<-unique(c(unlist(sapply(newNet$mel, "[[", "outl")),unlist(sapply(newNet$mel, "[[", "inl")))) removeV<-setdiff(seq_len(network.size(newNet)),v) delete.vertices(newNet,removeV) } #Return the updated object newNet } # Retrieve a specified network-level attribute from network x. The attribute # type depends on the underlying storage mode, and cannot be guaranteed. # #' @rdname attribute.methods #' @export get.network.attribute <- function(x, ...) { UseMethod("get.network.attribute") } #' @rdname attribute.methods #' @export get.network.attribute.network <- function(x, attrname, unlist=FALSE, ...) { x <- x$gal[[attrname]] if(unlist){unlist(x)}else{x} } # Retrieve the neighborhood of v in network x. Depending on the value of # type, the neighborhood in question may be in, out, or the union of the two. # The return value for the function is a vector containing vertex IDs. # #' Obtain the Neighborhood of a Given Vertex #' #' \code{get.neighborhood} returns the IDs of all vertices belonging to the in, #' out, or combined neighborhoods of \code{v} within network \code{x}. #' #' Note that the combined neighborhood is the union of the in and out #' neighborhoods -- as such, no vertex will appear twice. #' #' @param x an object of class \code{network} #' @param v a vertex ID #' @param type the neighborhood to be computed #' @param na.omit logical; should missing edges be ignored when obtaining #' vertex neighborhoods? #' @return A vector containing the vertex IDs for the chosen neighborhood. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{get.edges}}, \code{\link{is.adjacent}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' #' Wasserman, S. and Faust, K. 1994. \emph{Social Network Analysis: Methods #' and Applications.} Cambridge: Cambridge University Press. #' @keywords graphs #' @examples #' #' #Create a network with three edges #' m<-matrix(0,3,3) #' m[1,2]<-1; m[2,3]<-1; m[3,1]<-1 #' g<-network(m) #' #' #Examine the neighborhood of vertex 1 #' get.neighborhood(g,1,"out") #' get.neighborhood(g,1,"in") #' get.neighborhood(g,1,"combined") #' #' @export get.neighborhood get.neighborhood<-function(x, v, type=c("out","in","combined"), na.omit=TRUE){ #Check to be sure we were called with a network if(!is.network(x)) stop("get.neighborhood requires an argument of class network.") #Do some reality checking n<-network.size(x) if((v<1)||(v>n)) return(numeric(0)) #Retrieve the edges if(!is.directed(x)) type="combined" #If undirected, out==in==combined else type=match.arg(type) #Do the deed .Call(getNeighborhood_R,x,v,type,na.omit) } # Retrieve a specified vertex attribute (indicated by attrname) from network x. # Where na.omit==TRUE, values for missing vertices are removed; where # null.na==TRUE, NULL values are converted to NAs. The return value of this # function is a list. # #' @rdname attribute.methods #' @export get.vertex.attribute <- function(x, ...) { UseMethod("get.vertex.attribute") } #' @rdname attribute.methods #' @export get.vertex.attribute.network <- function(x, attrname, na.omit=FALSE, null.na=TRUE, unlist=TRUE, ...) { #Check to see if there's anything to be done if(network.size(x)==0){ return(NULL) } # MB: Showing warnings if attribute not present is infeasible and causes an # avalanche of problems downstream. Hence, it is commented-out here as a # warning to future generations of Statnet developers before they decide to # revisit the problem. C.f. https://github.com/statnet/network/issues/41 # #if(!(attrname %in% list.vertex.attributes(x))) # warning(paste('attribute', attrname,'is not specified for these vertices')) #Get the list of attribute values va<-lapply(x$val,"[[",attrname) #If needed, figure out who's missing if(na.omit) vna<-unlist(lapply(x$val,"[[","na")) else vna<-rep(FALSE,length(va)) #Replace NULL values with NAs, if requested if(null.na) va[sapply(va,is.null)]<-NA #Return the result if (na.omit){ x <- va[!vna] } else { x<-va } if(unlist){unlist(x)}else{x} } # Return TRUE iff network x has loops. # #' Indicator Functions for Network Properties #' #' Various indicators for properties of \code{network} class objects. #' #' These methods are the standard means of assessing the state of a #' \code{network} object; other methods can (and should) use these routines in #' governing their own behavior. As such, improper setting of the associated #' attributes may result in unpleasantly creative results. (See the #' \code{edge.check} argument to \code{\link{add.edges}} for an example of code #' which makes use of these network properties.) #' #' The functions themselves behave has follows: #' #' \code{has.loops} returns \code{TRUE} iff \code{x} is allowed to contain #' loops (or loop-like edges, in the hypergraphic case). #' #' \code{is.bipartite} returns \code{TRUE} iff the \code{x} has been explicitly #' bipartite-coded. Values of \code{bipartite=NULL}, and \code{bipartite=FALSE} #' will evaluate to \code{FALSE}, numeric values of \code{bipartite>=0} will #' evaluate to \code{TRUE}. (The value \code{bipartite==0} indicates that it is #' a bipartite network with a zero-sized first partition.) Note that #' \code{is.bipartite} refers only to the storage properties of \code{x} and #' how it should be treated by some algorithms; \code{is.bipartite(x)==FALSE} #' it does \emph{not} mean that \code{x} cannot admit a bipartition! #' #' \code{is.directed} returns \code{TRUE} iff the edges of \code{x} are to be #' interpreted as directed. #' #' \code{is.hyper} returns \code{TRUE} iff \code{x} is allowed to contain #' hypergraphic edges. #' #' \code{is.multiplex} returns \code{TRUE} iff \code{x} is allowed to contain #' multiplex edges. #' #' @name network.indicators #' #' @param x an object of class \code{network} #' @return \code{TRUE} or \code{FALSE} #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network}}, \code{\link{get.network.attribute}}, #' \code{set.network.attribute}, \code{\link{add.edges}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @keywords classes graphs #' @examples #' #' g<-network.initialize(5) #Initialize the network #' is.bipartite(g) #' is.directed(g) #' is.hyper(g) #' is.multiplex(g) #' has.loops(g) #' #' @export has.loops<-function(x){ if(!is.network(x)) stop("has.loops requires an argument of class network.") else get.network.attribute(x,"loops") } # Return TRUE iff (vi,vj) in network x. Where na.omit==TRUE, edges flagged # as missing are ignored. # #' Determine Whether Two Vertices Are Adjacent #' #' \code{is.adjacent} returns \code{TRUE} iff \code{vi} is adjacent to #' \code{vj} in \code{x}. Missing edges may be omitted or not, as per #' \code{na.omit}. #' #' Vertex \eqn{v} is said to be adjacent to vertex \eqn{v'} within directed #' network \eqn{G} iff there exists some edge whose tail set contains \eqn{v} #' and whose head set contains \eqn{v'}. In the undirected case, head and tail #' sets are exchangeable, and thus \eqn{v} is adjacent to \eqn{v'} if there #' exists an edge such that \eqn{v} belongs to one endpoint set and \eqn{v'} #' belongs to the other. (In dyadic graphs, these sets are of cardinality 1, #' but this may not be the case where hyperedges are admitted.) #' #' If an edge which would make \eqn{v} and \eqn{v'} adjacent is marked as #' missing (via its \code{na} attribute), then the behavior of #' \code{is.adjacent} depends upon \code{na.omit}. If \code{na.omit==FALSE} #' (the default), then the return value is considered to be \code{NA} unless #' there is also \emph{another} edge from \eqn{v} to \eqn{v'} which is #' \emph{not} missing (in which case the two are clearly adjacent). If #' \code{na.omit==TRUE}, on the other hand the missing edge is simply #' disregarded in assessing adjacency (i.e., it effectively treated as not #' present). It is important not to confuse \dQuote{not present} with #' \dQuote{missing} in this context: the former indicates that the edge in #' question does not belong to the network, while the latter indicates that the #' state of the corresponding edge is regarded as unknown. By default, all #' edge states are assumed \dQuote{known} unless otherwise indicated (by #' setting the edge's \code{na} attribute to \code{TRUE}; see #' \code{\link{attribute.methods}}). #' #' Adjacency can also be determined via the extraction/replacement operators. #' See the associated man page for details. #' #' @param x an object of class \code{network} #' @param vi a vertex ID #' @param vj a second vertex ID #' @param na.omit logical; should missing edges be ignored when assessing #' adjacency? #' @return A logical, giving the status of the (i,j) edge #' @note Prior to version 1.4, \code{na.omit} was set to \code{TRUE} by #' default. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{get.neighborhood}}, \code{\link{network.extraction}}, #' \code{\link{attribute.methods}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' #' Wasserman, S. and Faust, K. 1994. \emph{Social Network Analysis: Methods #' and Applications}. Cambridge: Cambridge University Press. #' @keywords graphs #' @examples #' #' #Create a very simple graph #' g<-network.initialize(3) #' add.edge(g,1,2) #' is.adjacent(g,1,2) #TRUE #' is.adjacent(g,2,1) #FALSE #' g[1,2]==1 #TRUE #' g[2,1]==1 #FALSE #' #' @export is.adjacent is.adjacent<-function(x,vi,vj,na.omit=FALSE){ if(!is.network(x)) stop("is.adjacent requires an argument of class network.\n") if(length(vi)!=length(vj)){ vi<-rep(vi,length=max(length(vi),length(vj))) vj<-rep(vj,length=max(length(vi),length(vj))) } #Do the deed .Call(isAdjacent_R,x,vi,vj,na.omit) } # Return TRUE iff network x is bipartite # #' @rdname network.indicators #' @param ... other arguments passed to/from other methods #' @export is.bipartite <- function(x, ...) UseMethod("is.bipartite") #' @rdname network.indicators #' @export is.bipartite.network<-function(x, ...){ bip <- get.network.attribute(x,"bipartite") if(is.null(bip)){ return(FALSE) } else if (is.logical(bip)){ return(bip) }else{ return(bip>=0) } } # Return TRUE iff network x is directed. # #' @rdname network.indicators #' @export is.directed <- function(x, ...) UseMethod("is.directed") #' @rdname network.indicators #' @export is.directed.network<-function(x, ...){ get.network.attribute(x,"directed") } # Return TRUE iff network x is hypergraphic. # #' @rdname network.indicators #' @export is.hyper<-function(x){ if(!is.network(x)) stop("is.hyper requires an argument of class network.\n") else get.network.attribute(x,"hyper") } # Return TRUE iff network x is multiplex. # #' @rdname network.indicators #' @export is.multiplex<-function(x){ if(!is.network(x)) stop("is.multiplex requires an argument of class network.\n") else get.network.attribute(x,"multiple") } # Return a network whose edges are the missing edges of x # #' @rdname network.naedgecount #' @name missing.edges #' @title Identifying and Counting Missing Edges in a Network Object #' #' @description \code{network.naedgecount} returns the number of edges within a #' \code{network} object which are flagged as missing. The \code{is.na} #' network method returns a new network containing the missing edges. #' #' @details The missingness of an edge is controlled by its \code{na} attribute (which #' is mandatory for all edges); \code{network.naedgecount} returns the number #' of edges for which \code{na==TRUE}. The \code{is.na} network method #' produces a new network object whose edges correspond to the missing #' (\code{na==TRUE}) edges of the original object, and is thus a covenient #' method of extracting detailed missingness information on the entire network. #' The network returned by \code{is.na} is guaranteed to have the same base #' network attributes (directedness, loopness, hypergraphicity, multiplexity, #' and bipartite constraint) as the original network object, but no other #' information is copied; note too that edge IDs are \emph{not} preserved by #' this process (although adjacency obviously is). Since the resulting object #' is a \code{\link{network}}, standard coercion, print/summary, and other #' methods can be applied to it in the usual fashion. #' #' It should be borne in mind that \dQuote{missingness} in the sense used here #' reflects the assertion that an edge's presence or absence is unknown, #' \emph{not} that said edge is known not to be present. Thus, the \code{na} #' count for an empty graph is properly 0, since all edges are known to be #' absent. Edges can be flagged as missing by setting their \code{na} #' attribute to \code{TRUE} using \code{\link{set.edge.attribute}}, or by #' appropriate use of the network assignment operators; see below for an #' example of the latter. #' #' @param x an object of class \code{network} #' @param \dots additional arguments, not used #' @return \code{is.na(x)} returns a network object, and #' \code{network.naedgecount(x)} returns the number of missing edges. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network.edgecount}}, #' \code{\link{get.network.attribute}}, \code{is.adjacent}, \code{\link{is.na}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @keywords classes graphs #' @examples #' #' #Create an empty network with no missing data #' g<-network.initialize(5) #' g[,] #No edges present.... #' network.naedgecount(g)==0 #Edges not present are not "missing"! #' #' #Now, add some missing edges #' g[1,,add.edges=TRUE]<-NA #Establish that 1's ties are unknown #' g[,] #Observe the missing elements #' is.na(g) #Observe in network form #' network.naedgecount(g)==4 #These elements do count! #' network.edgecount(is.na(g)) #Same as above #' #' #' @export is.na.network #' @export is.na.network<-function(x){ #Create an empty network with the same properties as x y<-network.initialize(network.size(x),directed=is.directed(x), hyper=is.hyper(x),loops=has.loops(x),multiple=is.multiplex(x), bipartite=x%n%"bipartite") #Add the missing edges of x to y y<-.Call(isNANetwork_R,x,y) #Return the updated network y } # Return TRUE iff x is a network. # #' Network Objects #' #' Construct, coerce to, test for and print \code{network} objects. #' #' \code{network} constructs a \code{network} class object from a matrix #' representation. If the \code{matrix.type} parameter is not specified, it #' will make a guess as to the intended \code{edgeset.constructors} function to #' call based on the format of these input matrices. If the class of \code{x} #' is not a matrix, network construction can be dispatched to other methods. #' For example, If the \code{ergm} package is loaded, \code{network()} can #' function as a shorthand for \code{as.network.numeric} with #' \code{x} as an integer specifying the number of nodes to be created in the #' random graph. #' #' If the \code{ergm} package is loaded, \code{network} can function as a #' shorthand for \code{as.network.numeric} if \code{x} is an integer specifying #' the number of nodes. See the help page for #' \code{as.network.numeric} in \code{ergm} package for details. #' #' \code{network.copy} creates a new \code{network} object which duplicates its #' supplied argument. (Direct assignment with \code{<-} should be used rather #' than \code{network.copy} in most cases.) #' #' \code{as.network} tries to coerce its argument to a network, using the #' \code{as.network.matrix} functions if \code{x} is a matrix. (If the argument #' is already a network object, it is returned as-is and all other arguments #' are ignored.) #' #' \code{is.network} tests whether its argument is a network (in the sense that #' it has class \code{network}). #' #' \code{print.network} prints a network object in one of several possible #' formats. It also prints the list of global attributes of the network. #' #' \code{summary.network} provides similar information. #' #' @name network #' #' @aliases as.network.network print.summary.network $<-.network <-.network #' @param x for \code{network}, a matrix giving the network structure in #' adjacency, incidence, or edgelist form; otherwise, an object of class #' \code{network}. #' @param vertex.attr optionally, a list containing vertex attributes. #' @param vertex.attrnames optionally, a list containing vertex attribute #' names. #' @param directed logical; should edges be interpreted as directed? #' @param hyper logical; are hyperedges allowed? #' @param loops logical; should loops be allowed? #' @param multiple logical; are multiplex edges allowed? #' @param bipartite count; should the network be interpreted as bipartite? If #' present (i.e., non-NULL, non-FALSE) it is the count of the number of actors #' in the bipartite network. In this case, the number of nodes is equal to the #' number of actors plus the number of events (with all actors preceeding all #' events). The edges are then interpreted as nondirected. Values of #' bipartite==0 are permited, indicating a bipartite network with zero-sized #' first partition. #' @param matrix.type one of \code{"adjacency"}, \code{"edgelist"}, #' \code{"incidence"}. See \code{\link{edgeset.constructors}} for details and #' optional additional arguments #' @param object an object of class \code{network}. #' @param na.omit logical; omit summarization of missing attributes in #' \code{network}? #' @param mixingmatrices logical; print the mixing matrices for the discrete #' attributes? #' @param print.adj logical; print the network adjacency structure? #' @param ... additional arguments. #' @return \code{network}, \code{as.network}, and \code{print.network} all #' return a network class object; \code{is.network} returns TRUE or FALSE. #' @note Between versions 0.5 and 1.2, direct assignment of a network object #' created a pointer to the original object, rather than a copy. As of version #' 1.2, direct assignment behaves in the same manner as \code{network.copy}. #' Direct use of the latter is thus superfluous in most situations, and is #' discouraged. #' #' Many of the network package functions modify their network object arguments #' in-place. For example, \code{set.network.attribute(net,"myVal",5)} will have #' the same effect as \code{net<-set.network.attribute(net,"myVal",5)}. #' Unfortunately, the current implementation of in-place assignment breaks when #' the network argument is an element of a list or a named part of another #' object. So \code{set.network.attribute(myListOfNetworks[[1]],"myVal",5)} #' will silently fail to modify its network argument, likely leading to #' incorrect output. #' @author Carter T. Butts \email{buttsc@@uci.edu} and David Hunter #' \email{dhunter@@stat.psu.edu} #' @seealso \code{\link{network.initialize}}, \code{\link{attribute.methods}}, #' \code{\link{as.network.matrix}}, \code{\link{as.matrix.network}}, #' \code{\link{deletion.methods}}, \code{\link{edgeset.constructors}}, #' \code{\link{network.indicators}}, \code{\link{plot.network}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @keywords classes graphs #' @examples #' #' m <- matrix(rbinom(25,1,.4),5,5) #' diag(m) <- 0 #' g <- network(m, directed=FALSE) #' summary(g) #' #' h <- network.copy(g) #Note: same as h<-g #' summary(h) #' #' @export is.network<-function(x){ inherits(x, "network") } # List attributes present on any edge # #' @rdname attribute.methods #' @export list.edge.attributes <- function(x, ...) { UseMethod("list.edge.attributes") } #' @rdname attribute.methods #' @export list.edge.attributes.network <- function(x, ...) { # no edges in the network if (network.edgecount(x, na.omit=F) == 0) return(character(0)) #Accumulate names allnam<-sapply(lapply(x$mel[!is.null(x$mel)],"[[","atl"),names) #Return the sorted, unique attribute names sort(unique(as.vector(unlist(allnam)))) } # List network-level attributes # #' @rdname attribute.methods #' @export list.network.attributes <- function(x, ...) { UseMethod("list.network.attributes") } #' @rdname attribute.methods #' @export list.network.attributes.network <- function(x, ...) { #Return the attribute names sort(names(x$gal)) } # List attributes present on any vertex # #' @rdname attribute.methods #' @export list.vertex.attributes <- function(x, ...) { UseMethod("list.vertex.attributes") } #' @rdname attribute.methods #' @export list.vertex.attributes.network <- function(x, ...) { if(network.size(x)==0){ return(NULL) } #Accumulate names allnam<-unlist(sapply(x$val,names)) #Return the sorted, unique attribute names sort(unique(as.vector(allnam))) } # Retrieve the number of free dyads (i.e., number of non-missing) of network x. # #' @export network.dyadcount<-function(x, ...) UseMethod("network.dyadcount") #' Return the Number of (Possibly Directed) Dyads in a Network Object #' #' \code{network.dyadcount} returns the number of possible dyads within a #' \code{network}, removing those flagged as missing if desired. If the #' network is directed, directed dyads are counted accordingly. #' #' The return value \code{network.dyadcount} is equal to the number of dyads, #' minus the number of \code{NULL} edges (and missing edges, if #' \code{na.omit==TRUE}). If \code{x} is directed, the number of directed #' dyads is returned. If the network allows loops, the number of possible #' entries on the diagnonal is added. Allthough the function does not give an #' error on multiplex networks or hypergraphs, the results probably don't make #' sense. #' #' @name network.dyadcount #' #' @param x an object of class \code{network} #' @param na.omit logical; omit edges with \code{na==TRUE} from the count? #' @param \dots possible additional arguments, used by other implementations #' @return The number of dyads in the network #' @author Mark S. Handcock \email{handcock@@stat.washington.edu}, skyebend #' @seealso \code{\link{get.network.attribute}}, #' \code{\link{network.edgecount}}, \code{\link{is.directed}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @keywords classes graphs #' @examples #' #' #Create a directed network with three edges #' m<-matrix(0,3,3) #' m[1,2]<-1; m[2,3]<-1; m[3,1]<-1 #' g<-network(m) #' network.dyadcount(g)==6 #Verify the directed dyad count #' g<-network(m|t(m),directed=FALSE) #' network.dyadcount(g)==3 #nC2 in undirected case #' #' @export network.dyadcount.network<-function(x,na.omit=TRUE,...){ nodes <- network.size(x) if(is.directed(x)){ if(is.bipartite(x)){ # directed bipartite nactor <- get.network.attribute(x,"bipartite") nevent <- nodes - nactor dyads <- nactor * nevent *2 }else{ # directed unipartite dyads <- nodes * (nodes-1) if(has.loops(x)){ # add in the diagonal dyads<-dyads+nodes } } }else{ # undirected if(is.bipartite(x)){ # undirected bipartite nactor <- get.network.attribute(x,"bipartite") nevent <- nodes - nactor dyads <- nactor * nevent }else{ # undirected unipartite dyads <- nodes * (nodes-1)/2 if(has.loops(x)){ # add in the diagonal dyads<-dyads+nodes } } } if(na.omit){ # # Adjust for missing # design <- get.network.attribute(x,"design") if(!is.null(design)){ dyads <- dyads - network.edgecount(design) }else{ design <- get.network.attribute(x,"mClist.design") if(!is.null(design)){ dyads <- dyads - design$nedges }else{ dyads <- dyads - network.naedgecount(x) } } } dyads } #Retrieve the number of edges in network x. # #' @export network.edgecount<-function(x, ...) UseMethod("network.edgecount") #' Return the Number of Edges in a Network Object #' #' \code{network.edgecount} returns the number of edges within a #' \code{network}, removing those flagged as missing if desired. #' #' The return value is the number of distinct edges within the network object, #' including multiplex edges as appropriate. (So if there are 3 edges from #' vertex i to vertex j, each contributes to the total edge count.) #' #' The return value \code{network.edgecount} is in the present implementation #' related to the (required) \code{mnext} network attribute. \code{mnext} is #' an internal legacy attribute that currently indicates the index number of #' the next edge to be added to a network object. (Do not modify it unless you #' enjoy unfortunate surprises.) The number of edges returned by #' \code{network.edgecount} is equal to \code{x\%n\%"mnext"-1}, minus the number #' of \code{NULL} edges (and missing edges, if \code{na.omit==TRUE}). Note #' that \code{g\%n\%"mnext"-1} cannot, by itself, be counted upon to be an #' accurate count of the number of edges! As \code{mnext} is not part of the #' API (and is not guaranteed to remain), users and developers are urged to use #' \code{network.edgecount} instead. #' #' @name network.edgecount #' #' @param x an object of class \code{network} #' @param na.omit logical; omit edges with \code{na==TRUE} from the count? #' @param \dots additional arguments, used by extending functio #' @return The number of edges #' @section Warning : \code{network.edgecount} uses the real state of the #' network object to count edges, not the state it hypothetically should have. #' Thus, if you add extra edges to a non-multiplex network, directed edges to #' an undirected network, etc., the actual number of edges in the object will #' be returned (and not the number you would expect if you relied only on the #' putative number of possible edges as reflected by the #' \link{network.indicators}). Don't create \code{network} objects with #' contradictory attributes unless you know what you are doing. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{get.network.attribute}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @keywords classes graphs #' @examples #' #' #Create a network with three edges #' m<-matrix(0,3,3) #' m[1,2]<-1; m[2,3]<-1; m[3,1]<-1 #' g<-network(m) #' network.edgecount(g)==3 #Verify the edgecount #' #' @export network.edgecount.network<-function(x,na.omit=TRUE,...){ .Call(networkEdgecount_R,x,na.omit) } #Retrieve the number of missing edges in network x # #' @rdname network.naedgecount #' @export network.naedgecount<-function(x, ...) UseMethod("network.naedgecount") #' @export network.naedgecount.network<-function(x, ...){ na<-get.edge.attribute(x$mel,"na") if(is.null(na)) 0 else sum(na) } # Retrieve the size (i.e., number of vertices) of network x. # #' Return the Size of a Network #' #' \code{network.size} returns the order of its argument (i.e., number of #' vertices). #' #' \code{network.size(x)} is equivalent to \code{get.network.attribute(x,"n")}; #' the function exists as a convenience. #' #' @param x an object of class \code{network} #' @param \dots additional arguments, not used #' @return The network size #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{get.network.attribute}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @keywords classes graphs #' @examples #' #' #Initialize a network #' g<-network.initialize(7) #' network.size(g) #' #' @export network.size network.size<-function(x, ...) UseMethod("network.size") #' @export network.size.network<-function(x, ...){ get.network.attribute(x,"n") } # Retrieve the vertex names of network x (if present). # #' @rdname attribute.methods #' @export network.vertex.names<-function(x){ if(!is.network(x)){ stop("network.vertex.names requires an argument of class network.") }else{ if(network.size(x)==0) return(NULL) vnames <- get.vertex.attribute(x,"vertex.names") if(is.null(vnames) | all(is.na(vnames)) ){ as.character(1:network.size(x)) }else{ vnames } } } # Set the vertex names of network x # #' @rdname attribute.methods #' @export "network.vertex.names<-"<-function(x,value){ set.vertex.attribute(x,attrname="vertex.names",value=value) } # Permute the internal IDs (ordering) of the vertex set #' Permute (Relabel) the Vertices Within a Network #' #' \code{permute.vertexIDs} permutes the vertices within a given network in the #' specified fashion. Since this occurs internally (at the level of vertex #' IDs), it is rarely of interest to end-users. #' #' \code{permute.vertexIDs} alters the internal ordering of vertices within a #' \code{\link{network}}. For most practical applications, this should not be #' necessary -- de facto permutation can be accomplished by altering the #' appropriate vertex attributes. \code{permute.vertexIDs} is needed for #' certain other routines (such as \code{\link{delete.vertices}}), where it is #' used in various arcane and ineffable ways. #' #' @param x an object of class \code{\link{network}}. #' @param vids a vector of vertex IDs, in the order to which they are to be #' permuted. #' @return Invisibly, a pointer to the permuted network. #' \code{permute.vertexIDs} modifies its argument in place. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @keywords manip graphs #' @examples #' #' data(flo) #Load the Florentine Families data #' nflo<-network(flo) #Create a network object #' n<-network.size(nflo) #Get the number of vertices #' permute.vertexIDs(nflo,n:1) #Reverse the vertices #' all(flo[n:1,n:1]==as.sociomatrix(nflo)) #Should be TRUE #' #' @export permute.vertexIDs permute.vertexIDs<-function(x,vids){ #First, check to see that this is a graph object if(!is.network(x)) stop("permute.vertexIDs requires an argument of class network.\n") #Sanity check: is this a permutation vector? n<-network.size(x) if((length(unique(vids))!=n)||any(range(vids)!=c(1,n))) stop("Invalid permutation vector in permute.vertexIDs.") if(is.bipartite(x)){ #If bipartite, enforce partitioning bpc<-get.network.attribute(x,"bipartite") if(any(vids[0:bpc]>bpc)||any(vids[(bpc+1):n]<=bpc)) warning("Performing a cross-mode permutation in permute.vertexIDs. I hope you know what you're doing....") } #Return the permuted graph xn<-substitute(x) x<-.Call(permuteVertexIDs_R,x,vids) if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } invisible(x) } # Set an edge attribute for network x. # # set.edge.attribute<-function(x,attrname,value,e=seq_along(x$mel)){ # #Check to be sure we were called with a network # if(!is.network(x)) # stop("set.edge.attribute requires an argument of class network.") # #Make sure that value is appropriate, coercing if needed # if(!is.list(value)){ # if(!is.vector(value)) # stop("Inappropriate edge value given in set.edge.attribute.\n") # else # value<-as.list(rep(value,length=length(e))) # }else # if(length(value)!=length(e)) # value<-rep(value,length=length(e)) # xn<-deparse(substitute(x)) # ev<-parent.frame() # if(length(e)>0){ # if((min(e)<1)|(max(e)>length(x$mel))) # stop("Illegal edge in set.edge.attribute.\n") # #Do the deed # x<-.Call("setEdgeAttribute_R",x,attrname,value,e, PACKAGE="network") # if(exists(xn,envir=ev)) #If x not anonymous, set in calling env # on.exit(assign(xn,x,pos=ev)) # invisible(x) # }else # invisible(x) # } #' @rdname attribute.methods #' @export set.edge.attribute <- function(x, attrname, value, e, ...) { UseMethod("set.edge.attribute") } #' @rdname attribute.methods #' @export set.edge.attribute.network <- function(x, attrname, value, e=seq_along(x$mel), ...) { # determine if we have to do anything at all if(length(e)>0){ if((min(e)<1)|(max(e)>length(x$mel))){ stop("Illegal edge in set.edge.attribute.\n") } xn<-substitute(x) # determine if we will be setting single or multiple values if(length(attrname)==1){ #Make sure that value is appropriate, coercing if needed if(!is.list(value)){ if(!is.vector(value)){ stop("Inappropriate edge value given in set.edge.attribute.\n") } else { value<-as.list(rep(value,length=length(e))) } } else { if(length(value)!=length(e)) { value<-rep(value,length=length(e)) } } #Do the deed, call the set single value version x<-.Call(setEdgeAttribute_R,x,attrname,value,e) } else { # we will be setting multiple values if (length(attrname)!=length(value)){ stop("the 'value' attribute must have an element corresponding to each attribute name in 'attrname' in set.edge.attribute") } #Make sure that value is appropriate, coercing if needed if(!is.list(value)){ if(!is.vector(value)){ stop("Inappropriate edge value given in set.edge.attribute.\n") } else { # value must be a vector # replicate each element of value e times if needed value<-lapply(1:length(value),function(n){ if (length(value[n])length(x$mel))) stop("Illegal edge in set.edge.value.\n") #Make sure that value is appropriate, coercing if needed n<-network.size(x) if(!is.matrix(value)){ if(is.vector(value)) value<-matrix(rep(value,length=n*n),n,n) else value<-matrix(value,n,n) } else if (min(dim(value)) < n) { stop("set.edge.value requires a matrix whose dimension is equal to or larger than the network size") } #Do the deed xn<-substitute(x) x<-.Call(setEdgeValue_R,x,attrname,value,e) if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } invisible(x) } # Set a network-level attribute for network x. # #' @rdname attribute.methods #' @export set.network.attribute <- function(x, attrname, value, ...) { UseMethod("set.network.attribute") } #' @rdname attribute.methods #' @export set.network.attribute.network <- function(x, attrname, value, ...) { #Make sure the values are consistent if(length(attrname)==1){ value<-list(value) }else{ if(is.list(value)){ value<-rep(value,length=length(attrname)) }else if(is.vector(value)){ value<-as.list(rep(value,length=length(attrname))) }else stop("Non-replicable value with multiple attribute names in set.network.attribute.\n") } #Do the deed xn<-substitute(x) x<-.Call(setNetworkAttribute_R,x,attrname,value) if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } invisible(x) } # Set a vertex attribute for network x. # This version has been removed so we can test one that can set multiple values at once # set.vertex.attribute<-function(x,attrname,value,v=seq_len(network.size(x))){ # #Check to be sure we were called with a network # if(!is.network(x)) # stop("set.vertex.attribute requires an argument of class network.") # #Perform some sanity checks # if(any((v>network.size(x))|(v<1))) # stop("Vertex ID does not correspond to actual vertex in set.vertex.attribute.\n") # #Make sure that value is appropriate, coercing if needed # if(!is.list(value)){ # if(!is.vector(value)) # stop("Inappropriate value given in set.vertex.attribute.\n") # else # value<-as.list(rep(value,length=length(v))) # }else # if(length(value)!=length(v)) # value<-rep(value,length=length(v)) # #Do the deed # xn<-deparse(substitute(x)) # ev<-parent.frame() # x<-.Call("setVertexAttribute_R",x,attrname,value,v, PACKAGE="network") # if(exists(xn,envir=ev)) #If x not anonymous, set in calling env # on.exit(assign(xn,x,pos=ev)) # invisible(x) # } # valid.eids returns a list of non-null edge ids for a given network #' Get the ids of all the edges that are valid in a network #' #' Returns a vector of valid edge ids (corresponding to non-NULL edges) for a #' network that may have some deleted edges. #' #' The edge ids used in the network package are positional indices on the #' internal "mel" list. When edges are removed using \code{\link{delete.edges}} #' \code{NULL} elements are left on the list. The function \code{valid.eids} #' returns the ids of all the valid (non-null) edge ids for its \code{network} #' argument. #' #' @param x a network object, possibly with some deleted edges. #' @return a vector of integer ids corresponding to the non-null edges in x #' @note If it is known that x has no deleted edges, \code{seq_along(x$mel)} is #' a faster way to generate the sequence of possible edge ids. #' @author skyebend #' @seealso See also \code{\link{delete.edges}} #' @examples #' #' net<-network.initialize(100) #' add.edges(net,1:99,2:100) #' delete.edges(net,eid=5:95) #' # get the ids of the non-deleted edges #' valid.eids(net) #' #' @export valid.eids valid.eids <-function(x){ # maybe should omit class test for speed? if (!is.network(x)){ stop("cannot determine non-null edge ids because argument x is not a network object") } # get the ids of all the non-null elements on the edgelist of x return(which(!sapply(x$mel,is.null))) } #' @rdname attribute.methods #' @export set.vertex.attribute <- function(x, attrname, value, v = seq_len(network.size(x)), ...) { UseMethod("set.vertex.attribute") } #' @rdname attribute.methods #' @export set.vertex.attribute.network <- function(x, attrname, value, v = seq_len(network.size(x)), ...) { #Perform some sanity checks if(any((v>network.size(x))|(v<1))) stop("Vertex ID does not correspond to actual vertex in set.vertex.attribute.\n") xn<-substitute(x) #Make sure that value is appropriate, coercing if needed if (length(attrname)==1){ # if we are only setting a single attribute use old version if(!is.list(value)){ if(!is.vector(value)){ stop("Inappropriate value given in set.vertex.attribute.\n") } else { value<-as.list(rep(value,length=length(v))) } } else { if(length(value)!=length(v)){ value<-rep(value,length=length(v)) } } # call older singular value version x<-.Call(setVertexAttribute_R,x,attrname,value,v) } else { # setting multiple values if (length(value)!=length(attrname)){ stop("the 'value' attribute must have an element corresponding to each attribute name in 'attrnames' in set.vertex.attribute") } if(!is.list(value)){ if(!is.vector(value)){ stop("Inappropriate value given in set.vertex.attribute.\n") } else { # value is a vector # replicate each element of value v times if needed value<-lapply(1:length(value),function(n){ if (length(value[n]); portions contributed by # David Hunter and Mark S. Handcock # . # # Last Modified 11/26/19 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains various routines related to reading/writing network # objects from external files. # # Contents: # # read.paj # read.paj.simplify # readAndVectorizeLine # switchArcDirection # ###################################################################### #Read an input file in Pajek format # some details at http://vlado.fmf.uni-lj.si/pub/networks/pajek/doc/pajekman.pdf p. 73 # generally this steps through the file until it finds markers for specific sub sections # when it sees one ('*Vertices*') it drops into a sub-loop that keeps advancing the file read # however, note that the overall loop may run multiple times in order to correctly detect all of the pieces in the file # things are made more complicated becaue there can be multiple *Edges or *Arcs definitions in a network # when it is a "mutliple network" (multiplex) http://vlado.fmf.uni-lj.si/pub/networks/doc/ECPR/08/ECPR01.pdf slide 21 # TODO: not sure if multiplex is set appropriately for this case # Also, attributes can be have 'default' values (the previous record) if not explicitly set on each row # TODO: need an argument to indicate if multiple sets of relations on the same vertex set should be returned # as a multiplex network or a list of networks. #' Read a Pajek Project or Network File and Convert to an R 'Network' Object #' #' Return a (list of) \code{\link{network}} object(s) after reading a #' corresponding .net or .paj file. The code accepts ragged array edgelists, #' but cannot currently handle 2-mode, multirelational (e.g. KEDS), or networks #' with entries for both edges and arcs (e.g. GD-a99m). See \code{network}, #' \code{statnet}, or \code{sna} for more information. #' #' #' If the \code{*Vertices} block includes the optional graphic attributes #' (coordinates, shape, size, etc.) they will be read attached to the network #' as vertex attributes but values will not be interperted (i.e. Pajek's color #' names will not be translated to R color names). Vertex attributes included #' in a \code{*Vector} block will be attached as vertex attributes. #' #' Edges or Arc weights in the \code{*Arcs} or \code{*Edges} block are include #' in the network as an attribute with the same name as the network. If no #' weight is included, a default weight of 1 is used. Optional graphic #' attributes or labels will be attached as edge attributes. #' #' If the file contains an empty \code{Arcs} block, an undirected network will #' be returned. Otherwise the network will be directed, with two edges (one in #' each direction) added for every row in the \code{*Edges} block. #' #' If the \code{*Vertices}, \code{*Arcs} or \code{*Edges} blocks having timing #' information included in the rows (indicated by `...` tokens), it will be #' attached to the vertices with behavior determined by the \code{time.format} #' option. If the \code{'networkDynamic'} format is used, times will be #' translated to \code{networkDynamic}'s spell model with the assumtion that #' the original Pajek representation was indicating discrete time chunks. For #' example \code{"[5-10]"} will become the spell \code{[5,11]}, \code{"[2-*]"} #' will become \code{[2,Inf]} and \code{"[7]"} will become \code{[7,8]}. See #' documentation for \code{networkDynamic}'s \code{?activity.attribute} for #' details. #' #' The \code{*Arcslist}, \code{*Edgelist} and \code{*Events} blocks are not yet #' supported. #' #' As there is no known single complete specification for the file format, #' parsing behavior has been infered from references and examples below. #' #' @aliases read.paj.simplify switchArcDirection readAndVectorizeLine #' @param file the name of the file whence the data are to be read. If it does #' not contain an absolute path, the file name is relative to the current #' working directory (as returned by \code{\link{getwd}}). \code{file} can #' also be a complete URL. #' @param verbose logical: Should longer descriptions of the reading and #' coercion process be printed out? #' @param debug logical: Should very detailed descriptions of the reading and #' coercion process be printed out? This is typically used to debug the reading #' of files that are corrupted on coercion. #' @param edge.name optional name for the edge variable read from the file. The #' default is to use the value in the project file if found. #' @param simplify Should the returned network be simplified as much as #' possible and saved? The values specifies the name of the file which the data #' are to be stored. If it does not contain an absolute path, the file name is #' relative to the current working directory (see \code{\link{getwd}}). If #' \code{specify} is TRUE the file name is the name \code{file}. #' @param time.format if the network has timing information attached to #' edges/vertices, how should it be processed? \code{'pajekTiming'} will #' attach the timing information unchanged in an attribute named #' \code{pajek.timing}. \code{'networkDynamic'} will translate it to a spell #' matrix format, attach it as an \code{'activity'} attribute and add the class #' \code{'networkDynamic'} -- formating it for use by the \code{networkDynamic} #' package. #' @return The structure of the object returned by \code{read.paj} depends on #' the contents of the file it parses. \itemize{ \item if input file contains #' information about a single 'network' object (i.e .net input file) a single #' network object is returned with attribute data set appropriately if #' possible. or a list of networks (for .paj input). \item if input file #' contains multiple sets of relations for a single network, a list of network #' objects ('network.series') is returned, along with a formula object?. \item #' if input .paj file contains additional information (like partition #' information), or multiple \code{*Network} definitions a two element list is #' returned. The first element is a list of all the network objects created, #' and the second is a list of partitions, etc. (how are these matched up) } #' @author Dave Schruth \email{dschruth@@u.washington.edu}, Mark S. Handcock #' \email{handcock@@stat.washington.edu} (with additional input from Alex #' Montgomery \email{ahm@@reed.edu}), Skye Bender-deMoll #' \email{skyebend@@uw.edu} #' @seealso \code{\link{network}} #' @references Batagelj, Vladimir and Mrvar, Andrej (2011) Pajek Reference #' Manual version 2.05 #' \url{http://vlado.fmf.uni-lj.si/pub/networks/pajek/doc/pajekman.pdf} Section #' 5.3 pp 73-79 #' #' Batageli, Vladimir (2008) "Network Analysis Description of Networks" #' \url{http://vlado.fmf.uni-lj.si/pub/networks/doc/ECPR/08/ECPR01.pdf} #' #' Pajek Datasets \url{http://vlado.fmf.uni-lj.si/pub/networks/data/esna/} #' @keywords datasets #' @examples #' #' \dontrun{ #' require(network) #' #' par(mfrow=c(2,2)) #' #' test.net.1 <- read.paj("http://vlado.fmf.uni-lj.si/pub/networks/data/GD/gd98/A98.net") #' plot(test.net.1,main=test.net.1%n%'title') #' #' test.net.2 <- read.paj("http://vlado.fmf.uni-lj.si/pub/networks/data/mix/USAir97.net") #' # plot using coordinates from the file in the file #' plot(test.net.2,main=test.net.2%n%'title', #' coord=cbind(test.net.2%v%'x', #' test.net.2%v%'y'), #' jitter=FALSE) #' #' # read .paj project file #' # notice output has $networks and $partitions #' read.paj('http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/Tina.paj') #' } #' #' @export read.paj read.paj <- function(file,verbose=FALSE,debug=FALSE, edge.name=NULL, simplify=FALSE,time.format=c('pajekTiming','networkDynamic')) { time.format<-match.arg(time.format) # process filename if(inherits(file, "connection")){ fileNameParts0 <- strsplit(summary(file)$'description',"/")[[1]] } else { fileNameParts0<-strsplit(file,"/")[[1]] } # split again to try to get file extension fileNameParts1 <- strsplit(fileNameParts0[length(fileNameParts0)],"\\.")[[1]] # filename may not have extension if(length(fileNameParts1)>1){ fileName <- paste(fileNameParts1[1:length(fileNameParts1)-1],collapse=".") fileExt <- fileNameParts1[length(fileNameParts1)] #should be "net" or "paj" (but never used ?) } else { fileName<-fileNameParts1 fileExt<-"" } # open connection (if it is not one already) if (is.character(file)) { file <- file(file, "rt") on.exit(close(file)) } if (!inherits(file, "connection")) stop("argument 'file' must be a character string or connection") if (!isOpen(file)) { open(file, "rt") on.exit(close(file)) } isSeekable <- regexpr("http",file)>0 # also disable seeking if a gz connection, as it will break if(summary(file)$'class'=='unz'){ isSeekable<-FALSE } # initialize state tracking variables lineNumber<-0 # input line number parsed for debugging nnetworks <- 0 # number of networks (edge types) in current *Network block network.names <- NULL # names of networks (edge types) in current *Network block vertex <- NULL # has the vertex block been found? nvertex <- 0 # number of vertices in currently processing network network.title <- fileName # default name for network is filename partition <- NULL # partitions, if found names.partition <- NULL # names of partitions, if found vector <- NULL # vectors, if found colnames.vector <- NULL # names of vectors if found projects <- list() # projects if found (each set of related networks is a 'project') nprojects <- 0 # number of projects found names.projects <- NULL # names of projects if found. nextline <- TRUE # control flag to indicate if should proceede to next line line <- " " # usually tokens corresponding to line being red previousArcs<-NULL previousEdges<-NULL edgeData<-NULL is2mode <- FALSE # flag indicating if currently processing biparite network nevents <- 0 # for two-mode data, size of first mode nactors <- 0 # for two-mode data, size of second mode multiplex<-FALSE # flag indicating if currently processing multiplex network loops<-FALSE # begin file parsing while(!inherits(line,"try-error")){ while(any(grep("^%", line)) | nextline){ if(debug) print(paste("new parsing loop started at line",lineNumber)) options(show.error.messages=FALSE) # read the next line with error messages disabled line <- try(readLines(file, 1, ok = FALSE)) options(show.error.messages=TRUE) # If the line was not an error, tokenize using space as seperator if(!inherits(line,"try-error") & length(line)>0){ line <- strsplit(line, " ")[[1]] line <- line[line!=""] lineNumber<-lineNumber+1 } nextline <- FALSE # there was an error (probably end of file) so don't parse anymore } nextline <- TRUE # if(verbose) warning(paste("afterbeingWhileLoop",line)) # # ---- Network parsing ------- # Search for lines begining with *Network within the .paj file # not all files will include a *Network heading (usually only .paj) # it indicates that all the following sections (vertices, partitions, etc) belong to that network if(any(grep("\\*Network", line, ignore.case = TRUE))){ if (verbose) print(paste('parsing *Network block at line',lineNumber)) if(debug){ print(paste(" nnetworks=",nnetworks)) print(paste(" network.names=",network.names)) print(paste(" vertex null?",is.null(vertex))) print(paste(" network.title=",network.title)) print(paste(" vector null?",is.null(vector))) print(paste(" colnames.vector=",colnames.vector)) print(paste(" names.projects=",names(projects))) } if(verbose) print(paste("number of networks",nnetworks)) #dschruth added # we are about to start a new network, so need to run the post-processing # code on the previously parsed network (if there is one) if(nnetworks > 0 ){ if(debug) print("assembleing networks into 'project'") # grab all the named networks from the environment # and put 'em in a list networksData<-lapply(network.names,function(netName){get(netName)}) # TODO: delete networks from environment to clear up space? # take the various objects that have been parsed from the .paj file and assemble # them into a network object (or list of network objects, a 'project'), doing some appropriate conversion projects <- postProcessProject( network.title, vector, colnames.vector, vertex, # data for building vertices, edgeData, nnetworks, # number of networks found, network.names, # names of networks found networksData, projects, time.format, verbose ) } else { # networks have not been created, but need to check if only vertices have been found and empty network needed if(!is.null(vertex)){ # need to initialize a network here to deal with the case where no arcs/edge in the file # Note that without the arcs/edge, we have no way to know if network was supposed to be directed or multiplex networksData<-list( network.initialize(n=nvertex, bipartite=nactors)) projects <- postProcessProject( network.title, vector, colnames.vector, vertex, # data for building vertices, edgeData, nnetworks, # number of networks found, network.names=network.title, # names of networks found networksData, projects, time.format, verbose) } } # since we are starting a new network, reset all of the network level info, directed, 2mode, etc network.title <-NULL network.names <- NULL vertex<-NULL nvertex<-0 nnetworks <- 0 vector <- NULL colnames.vector <- NULL nextline <- TRUE arcsLinePresent<-FALSE edgesLinePresent<-FALSE previousArcs<-NULL previousEdges<-NULL is2mode <- FALSE #for two-mode data nevents <- 0 #for two-mode data nactors <- 0 #for two-mode data multiplex<-FALSE loops<-FALSE # now parse the new network title network.title <- paste(line[-1],collapse=" ") if(is.null(network.title)){ network.title <- network.name # this seems wrong, should be file name? warning('no name found for network, using "',network.name,'"') } } # END NETWORK PARSING BLOCK # # vertices specification # search for lines beignning with *Vertices # and then read in the number of lines equal to the expected number of vertices if(any(grep("\\*Vertices", line, ignore.case = TRUE))){ if (verbose) print(paste('parsing *Vertices block at line',lineNumber)) previousArcs <- NULL #used for arc+edge specified networks.... reset to null for every new network.. might be sufficient here previousEdges<-NULL nvertex <- as.numeric(line[2]) # parse the number of vertices #nnetworks <- nnetworks + 1 # if we found vertices, we must have a network # give the network a default name (may be overwritten later) network.name <- paste(network.title,sep="") if(!is.na(line[3])){ #dschruth added for two-mode is2mode <- TRUE #used in matrix below #dschruth added for two-mode nactors <- as.numeric(line[3]) #used for error check #dschruth added for two-mode nevents <- nvertex-nactors #used for error check #dschruth added for two-mode } #dschruth added for two-mode if(isSeekable){ # cache the table position in the input file in case we need to jump pack here later preReadTablePosition <- seek(file,where=NA) } # if(network.title =="SanJuanSur_deathmessage.net") #read.third paragraph in details of documentation of read table about how it determines the number of columns in the first 5 lines... # vertex <- read.table(file,skip=-1,nrows=nvertex,col.names=1:8,comment.char="%",fill=TRUE,as.is=FALSE) #dschruth added 'comment.char="%"' and 'fill=TRUE' # else # read it as table # NOTE: rows may omit values () vertex <- read.table(file,skip=-1,nrows=nvertex, comment.char="%",fill=TRUE,as.is=FALSE,row.names=NULL) if(ncol(vertex)==1){ vertex <- cbind(1:nrow(vertex),vertex)} #need to check to see if we are reading in more vertex rows than there actually are (some edges are implied) edgelistPosition <- grep("\\*(arcs|edges|matrix)",as.matrix(vertex),ignore.case=TRUE, useBytes = TRUE) if(any(edgelistPosition)){ if(verbose){ print("vertex list has missing entries or n was mis-specified, re-reading it...") } else { warning('vertex list has missing entries or n was mis-specified, re-reading it...') } if(!isSeekable) stop("Resize of abbreviated vertex list via seek is not possible with URLs. Try downloading file and loading locally") nVertexRows <- edgelistPosition-1 dummyNotUsed <- seek(file,where=preReadTablePosition) #reset the file position back to before the table was read vertex <- read.table(file,skip=-1,nrows=nVertexRows,comment.char="%",fill=TRUE,as.is=FALSE,) #dschruth added 'comment.char="%"' and 'fill=TRUE' if(ncol(vertex)==1){ vertex <- cbind(1:nrow(vertex),vertex)} } if(nvertex!=nrow(vertex)){ if(verbose){ print(paste("vertex list (length=",nrow(vertex),") is being re-sized to conform with specified network size (n=",nvertex,")",sep="")) } colnames(vertex)[1:2] <- c("vn","name") vertex <- merge(data.frame(vn=1:nvertex),vertex,all.x=TRUE,all.y=FALSE,by.y="vn") #fill in the holes with NA names } # increment the debugging line counter lineNumber<-lineNumber+nvertex if(verbose) print(paste(" found",nvertex,'vertices')) } # end vertices parsing block # # partition specification (vertex level attribute) # if(any(grep("\\*Partition", line, ignore.case = TRUE))){ if (verbose) print(paste('parsing *Partition block at line',lineNumber)) partition.name <- as.character(paste(line[-1],collapse=".")) names.partition <- c(names.partition,partition.name) line <- readAndVectorizeLine(file) lineNumber<-lineNumber+1 # update debugging line number # skip comments while(any(grep("^%", line))){ line <- readAndVectorizeLine(file) lineNumber<-lineNumber+1 # update debugging line number } nvertex <- as.numeric(line[2]) if(is.null(partition)){ partition <- read.table(file,skip=0,nrows=nvertex) lineNumber<-lineNumber+nvertex # update debugging line number }else{ partition <- c(partition, read.table(file,skip=0,nrows=nvertex)) lineNumber<-lineNumber+nvertex # update debugging line number } if(verbose) print("partition found and set") # TODO: why is partition not attached as vertex attribute? } # # ----- Vector specification (vetex-level attribute) ----- # if(any(grep("\\*Vector", line, ignore.case = TRUE))){ if (verbose) print(paste('parsing *Vector block at line',lineNumber)) vector.name <- as.character(paste(line[-1],collapse=".")) colnames.vector <- c(colnames.vector,vector.name) line <- readAndVectorizeLine(file) lineNumber<-lineNumber+1 # update debugging line number # skip comments while(any(grep("^%", line))){ line <- readAndVectorizeLine(file) lineNumber<-lineNumber+1 # update debugging line number } nvertex <- as.numeric(line[2]) if(is.null(vector)){ vector <- read.table(file,skip=0,nrows=nvertex) lineNumber<-lineNumber+nvertex # update debugging line number }else{ vector <- data.frame(vector, read.table(file,skip=0,nrows=nvertex)) lineNumber<-lineNumber+nvertex # update debugging line number } if(verbose) print("vector found and set") } # # ----- arcs / edges specification -------- # arcsLinePresent<-any(grep("\\*Arcs$", line, ignore.case = TRUE)) edgesLinePresent<-any(grep("\\*Edges$", line, ignore.case = TRUE)) if(arcsLinePresent | edgesLinePresent){ if(arcsLinePresent){ if(verbose) print(paste("parsing *Arcs block at line",lineNumber)) # if we had already parsed an arcs block, and we just found another one, better clear the old if(!is.null(previousArcs)){ previousArcs<-NULL } } else { if(verbose) print(paste("parsing *Edges block at line",lineNumber)) # if we had already parsed an edges block, and we just found another one, better clear the old if(!is.null(previousEdges)){ previousEdges<-NULL } } if(missing(edge.name)){ if(length(line)>1){ # this *Arcs / *Edges block is definding a named 'network' of relationships network.name <- strsplit(paste(line[3:length(line)],collapse="."),'\"')[[1]][2] #dschruth added collapse to allow for multi work network names #Note: don't increment the number of networks found until later, because this is executed for both arcs and edges block }else{ # append an index to the network name (to be used as edge attribute) only if we've seen multiple networks network.name <- paste(network.title,ifelse(nnetworks>0,nnetworks,''),sep="") #network.name <- network.title #old way } }else{ # define the network name as the edge name passed in by user # TODO: seems like if user passes in edge.name, multirelational edges will not be parsed correctly # because they will be given the same name network.name <- edge.name } dyadList <- list() #dschruth changed (was NULL) listIndex <- 1 #dschruth added line <- readAndVectorizeLine(file) lineNumber<-lineNumber+1 # update debugging line number # skip comments / blank lines while(any(grep("^%", line))){ line <- readAndVectorizeLine(file) lineNumber<-lineNumber+1 # update debugging line number } # keep reading lines until reaching the end of the block while(!any(grep("\\*[a-zA-Z]", line)) & length(line)>0){ #dschruth changed \\* to \\*[a-zA-Z] to allow for time asterisks # check line length for parse problems # should be fromId,toId, weight # if there are not 3, matrix reform will go bad later on if(length(line)<2){ stop("Arc/Edge record on line ",lineNumber," does not appear to have the required 2 elements:'",paste(line,collapse=' '),"'") } dyadList[[listIndex]] <- gsub("Newline","",line) # replace any newlines line <- readAndVectorizeLine(file) lineNumber<-lineNumber+1 # update debugging line number listIndex <- listIndex+1 } if(verbose) print(paste(" length of dyad list",length(dyadList))) nextline <- FALSE # check if we found any dyads if(length(dyadList)>0){ ### deal with the possible Ragged Array [RA] dyad list .. see Lederberg.net ### #TODO: I think this was for dealing with *arcslist / *edgelist, move to seperate section or do detection directly RAlengths <- unlist(lapply(dyadList,length)) maxRAwidth <- max(RAlengths) # TODO: this is an ugly error-prone way to check if there are attributes, need to fix # dyadsHaveAttributes <- any(is.na(as.numeric(unlist(dyadList)))) # handling edge attributes (NAs introduced by coersion) # if(dyadsHaveAttributes){ # warning(paste("don't worry about these",length(dyadList),"warnings,the dyads have attributes and were NA'ed during as.numeric() call. \n the actual dyad matrix width is only 2 ")) # } # # if(maxRAwidth > 4 & !dyadsHaveAttributes){# #needs to be 4 because of normal edgelist can have sender reciever weight and time # if(verbose)print(" stacking ragged dyad array ") # dyads0 <- unlist(lapply(dyadList, function(x) c(x, rep(NA, maxRAwidth - length(x))))) # dyads1 <- data.frame(matrix(dyads0,nrow=length(dyadList),ncol=maxRAwidth,byrow=TRUE)) # # colnames(dyads1) <- c("sender","receiver",paste("r",seq(3,maxRAwidth),sep="")) # # dyads2 <- reshape(dyads1,idvar="senderNo",ids=row.names(dyads1),direction="long", # times=names(dyads1)[-1],timevar="receiverNo", # varying=list(names(dyads1)[-1])) # # dyads <- as.matrix(dyads2[!is.na(dyads2$receiver),c("sender","receiver")]) # # if(verbose)print("finished stacking ragged dyad array") # }else{ # not a ragged array ### done dealing with RA possiblity ### all written by dschruth if(debug) print(" unlisting dyad list to matrix") # check if weight was ommited if (all(RAlengths==2)){ # assume default weight of 1 # convert to data.frame by first unlisting and dumping into 3 col matrix edgeData <- as.data.frame(stringsAsFactors=TRUE,matrix(unlist(lapply(dyadList,function(x){ c(as.numeric(x[1:2]),1)})), nrow=length(dyadList),ncol=3,byrow=TRUE)) if(verbose) print('weights ommited from arcs/edges lines, assuming weight of 1') } else { # create a data frame from the (possibly ragged) rows of the dyadList edgeData<-as.data.frame(stringsAsFactors=TRUE,fillMatrixFromListRows(dyadList)) # convert to appropriate class, have to convert to character first because it is a factor and NA will be recoded wrong edgeData[,1]<-as.numeric(as.character(edgeData[,1])) edgeData[,2]<-as.numeric(as.character(edgeData[,2])) edgeData[,3]<-as.numeric(as.character(edgeData[,3])) } # } # version with just first two columns to make checking easier dyads<-cbind(edgeData[,1:2]) # check for non-numeric ids (bad coercion) if(any(is.na(dyads))){ badRows<-lineNumber-(which(is.na(dyads),arr.ind=TRUE)[,1]) stop('vertex id columns in arcs/edges definition contains non-numeric or NA values on line(s) ',paste(badRows,collapse=' ')) } # check for non-integer vertex ids if(any(round(dyads)!=dyads)){ badRows<-lineNumber-(which(round(dyads)!=dyads,arr.ind=TRUE)[,1]) stop('vertex id columns in arcs/edges definition contains non-integer values on line(s) ',paste(badRows,collapse=' ')) } # check for out of range vertex ids if((max(dyads) > nvertex)){ # nrow(dyads)==1 is for C95.net # figure out which rows are bad badRows<-1+lineNumber-(which(dyads > nvertex,arr.ind=TRUE)[,1]) stop("vertex id(s) in arcs/edge definition is out of range on line(s) ",paste(badRows,collapse=' ')) #if(verbose) print("first dyad list (arcs?), is too short to be a full network, skipping to next dyad list (edges?)") } if(is.null(previousArcs) & is.null(previousEdges)){ #first time through (always an arc list?) # definitly creating a network, so increment the counter and names nnetworks <- nnetworks + 1 network.names <- c(network.names, network.name) if(arcsLinePresent){ directed <- TRUE previousArcs <- edgeData } else { previousEdges <- edgeData # there must not be an arcs block, so assume undirected directed <-FALSE } }else{ #second time through (always an edge list?) if(verbose) print(paste("previous dyads exist!! symmetrizing edges and combining with arcs")) if(edgesLinePresent){ # should only be edges edgeData.flipped <- switchArcDirection(edgeData) edgeData <- rbind(previousArcs,edgeData,edgeData.flipped) # TODO: what if arcs and edges don't have same number of cols }else{ stop('reached sequence of multiple *Arcs blocks, parsing code must have bad logic') } previousArcs <- NULL # we've used 'em, so null it out } # check for multiple ties repeatLines<-anyDuplicated(dyads) if(repeatLines>0){ multiplex<-TRUE if(verbose) print('network contains duplicated dyads so will be marked as multiplex') } # check for self-loops loopLines<-which(dyads[,1]==dyads[,2]) if (length(loopLines)>0){ loops<-TRUE if(verbose) print('network contains self-loop edges so will be marked as such') } ## initialize the appropriate type of network # NOTE: network creation occurs TWICE for networks with both arcs and edges, but the first network # is overwritten by the second. Needlessly slow on large nets, but difficult to avoid, since # we don't know if there is a 2nd block on the first pass if(is2mode){ temp <- network.initialize(n=nvertex, directed=directed, bipartite=nactors,multiple=multiplex,loops=loops) }else{ temp <- network.initialize(n=nvertex, directed=directed,multiple=multiplex,loops=loops) } # add in the edges add.edges(temp,tail=edgeData[,1],head=edgeData[,2]) # temp <- network(x=dyads[,1:2],directed=directed)#arcsLinePresent)#dschruth added if(ncol(edgeData)>2){ #only try to set the edge value if there is a third column (there always is?) temp <- set.edge.attribute(temp,network.names[nnetworks], edgeData[,3]) if(verbose) print(paste(" edge weight attribute named",network.names[nnetworks],"created from edge/arc list")) } assign(network.names[nnetworks], temp) rm(temp) if(verbose) print("network created from edge/arc list") # if(arcsLinePresent) nextline <- TRUE #{ print(" 'arcs' line followed by dyads present... skip past the current 'edges' line");} # end of edge/arc adding } } # # ----- matrix parsing ------- # if(any(grep("\\*Matrix", line, ignore.case = TRUE))){ if(verbose) print(paste('parsing *Matrix block at line',lineNumber)) if(length(line)>1){ # if a network name is given, use that network.name <- strsplit(line[3],'\"')[[1]][2] }else{ # otherwise name it acoding to the file name, adding a digit if we've seen multiple nets #network.name <- paste("network",nnetworks+1,sep="") network.name <- paste(network.title,ifelse(nnetworks>0,nnetworks,''),sep="") } nnetworks <- nnetworks + 1 network.names <- c(network.names, network.name) temp0 <- as.matrix(read.table(file,skip=0,nrows=nvertex,as.is=TRUE)) lineNumber<-lineNumber+nvertex lastColNum <- ncol(temp0) if(all(apply(temp0[,-lastColNum],1,sum)==temp0[,lastColNum])){ if(verbose) print("removing final marginal sum column of matrix") temp0 <- temp0[,-lastColNum] } if(verbose) print(paste(" matrix dimensions: dim1",dim(temp0)[1],"na",nactors,"dim2",dim(temp0)[2],"ne",nevents)) #checking if(is2mode & (dim(temp0)[1]!=nactors | dim(temp0)[2]!=nevents)){ stop("dimensions do not match bipartite specifications") }else{ # check for self-loops loops<- # convert the adjacency matrix to a network, using values as an edge attribute temp <- as.network.matrix(x=temp0, matrix.type='adjacency', bipartite=is2mode, #dschruth added "bipartate=is2mode" for two-mode ignore.eval=FALSE, names.eval=network.name, loops=any(diag(temp0)>0) # check for self-looops ) if(verbose) print("network created from matrix") } assign(network.names[nnetworks], temp) rm(temp) } # detect and report some formats that we cannot yet parse if(any(grep("\\*Arcslist", line, ignore.case = TRUE))){ warning(paste('skipped *Arcslist block at line',lineNumber, ' read.paj does not yet know how to parse it ')) #TODO: see http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/TinaList.net } if(any(grep("\\*Edgeslist", line, ignore.case = TRUE))){ warning(paste('skipped *Edgeslist block at line',lineNumber, ' read.paj does not yet know how to parse it ')) # TODO: see http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/TinaList.net } if(any(grep("\\*Events", line, ignore.case = TRUE))){ stop(paste('found *Events block at line',lineNumber, ' read.paj does not yet know how to parse Event timing format ')) # TODO: see http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/Friends.tim } } # end file-parsing while loop if(verbose){ print(paste('End of file reached at line',lineNumber)) } #if(is.null(network.title)) network.title <- network.name if(debug){ print(paste("nnetworks=",nnetworks)) print(paste("network.names=",network.names)) print(paste("vertex null?",is.null(vertex))) print(paste("network.title=",network.title)) print(paste("vector null?",is.null(vector))) print(paste("colnames.vector=",colnames.vector)) print(paste("nprojects=",length(projects))) print(paste("names.projects=",names(projects))) } if(verbose) print(paste("number of networks found:",nnetworks)) #dschruth added # ------------ post-processing -------------------- if(nnetworks > 0){ if(debug) print("assembling networks into 'project' before returning") # grab all the named networks from the environment # and put 'em in a list networksData<-lapply(network.names,function(netName){get(netName)}) # TODO: delete networks from environment to clear up space? # this code takes the various objects that have been parsed from the .paj file and assembles # them into a network object (or list of network objects, a 'project'), doing some appropriate conversion projects <- postProcessProject( network.title, vector, colnames.vector, vertex, # data for building vertices, edgeData, nnetworks, # number of networks found, network.names, # names of networks found networksData, projects, time.format, verbose ) } else { # networks have not been created, but need to check if only vertices have been found if(!is.null(vertex)){ # need to initialize a network here to deal with the case where no arcs/edge in the file # Note that without the arcs/edge, we have no way to know if network was supposed to be directed or multiplex networksData<-list( network.initialize(n=nvertex, bipartite=nactors)) projects <- postProcessProject( network.title, vector, colnames.vector, vertex, # data for building vertices, edgeData=NULL, nnetworks, # number of networks found, network.names = network.title, # names of networks found networksData, projects, time.format, verbose) } } if(is.null(partition)){ if(verbose) print(paste("number of projects",length(projects))) #dschruth added # if there is only one 'project' (network) remove it from the list and return it that way. if(length(projects)==1){ projects <- projects[[1]] } if(nnetworks>1){ if (verbose){ print('appending network objects into a network.series') } class(projects) <- "network.series" } }else{ names(partition) <- names.partition if (verbose){ print('returning projects and partitions as seperate list elements') } projects <- list(networks=projects, partitions=partition) } #end ifelse # # Simplify # if(is.logical(simplify)){ if(simplify){ simplify <- fileName }else{ return(projects) } } read.paj.simplify(x=projects,file=simplify,verbose=verbose) } #end read.paj # this code takes the various objects that have been parsed from the .paj file and assembles # them into a network object (or list of network objects, a 'project'), doing some appropriate conversion # this is called whenever the main parsing loop believes that it has finished with a section of # the .paj file describing a group of networks. # this code is extracted here because it can be called from two different places and must remain identical postProcessProject<-function( network.title, vector, colnames.vector, vertex, # data for building vertices, edgeData, # data for building edges nnetworks, # number of networks found, network.names, # names of networks found networksData, # list of basic networks created projects, time.format, verbose ){ colnames(vector) <- colnames.vector colnames(vertex) <- c("vertex.numbers","vertex.names","cen1","cen2")[1:ncol(vertex)] networks <- vector("list",length=nnetworks) if(verbose) print(paste("processing networks:",paste(network.names,collapse=', '))) for(i in seq(along=network.names)){ temp <- networksData[[i]] isDynamic<-FALSE if(!is.null(vertex)){ if (nrow(as.data.frame(stringsAsFactors=TRUE,vertex)) == network.size(temp)) { # set the vertex names to match names in file temp <- set.vertex.attribute(temp, "vertex.names", as.character(vertex[as.numeric(vertex[,1]),2])) if (ncol(vertex)>2) { # number of columns > 2 -> vertex has attributes #vert.attr.nam <- c("na","vertex.names","x","y") #assume first three are coords (true?) vert.attr.nam <- c("na","vertex.names",seq_len(ncol(vertex))) #temp names for rest # verify that coordinates are numeric if(ncol(vertex)>=3 && all(is.numeric(vertex[,3]))){ vert.attr.nam[3] <- 'x' } if(ncol(vertex)>=4 && all(is.numeric(vertex[,4]))){ vert.attr.nam[4] <- 'y' } # check if z coordinate exists and add it if it does if(ncol(vertex)>=5 && all(is.numeric(vertex[,5]))){ vert.attr.nam[5] <- 'z' } # loop over each column of vertex attributes for (vert.attr.i in 3:ncol(vertex)){ v <- vertex[,vert.attr.i] if (is.factor(v)){ # if it's a factor (non-numeric), then vert.attr.nam.tmp <- levels(v)[1] # see if the first factor is an attribute name if (vert.attr.nam.tmp=="") vert.attr.nam.tmp <- levels(v)[2] # in case of missing data if (nlevels(v)<=2&!is.na(match(vert.attr.nam.tmp, # check for match if # factors <=2 c("s_size","x_fact","y_fact","phi","r","q", "ic","bc","bw","lc","la","lr", "lphi","fos","font")))) { #from pajekman.pdf v1.2.3 p.69-70 vert.attr.nam[vert.attr.i+1] <- vert.attr.nam.tmp #if match, name the next column } else { #if not, set the attribute, converting to character (networks incompat w/factors) # if this is the 6th column, assume it is a shape name # but it could be the 5th column if z is missing (ugg, I hate this format!) if('z'%in%vert.attr.nam){ if(vert.attr.i==6 ){ vert.attr.nam[6]<-'shape' } } else { if(vert.attr.i==5 ){ vert.attr.nam[5]<-'shape' } } # spec says missing values should be filled in by row above values<-as.character(vertex[as.numeric(vertex[,1]),vert.attr.i]) missingVals<-which(values=='') while(length(missingVals)>0){ values[min(missingVals)]<-values[min(missingVals)-1] missingVals<-which(values=='') } # special processing: # check if it has brackets for time info, if so added if (length(grep('^\\[.+\\]$',values))>0) { isDynamic<-TRUE # if using pajeck time structure, just assign it if(time.format=='pajekTiming'){ vert.attr.nam[vert.attr.i]<-'pajekTiming' } else if (time.format =='networkDynamic'){ # if using nd, convert to spell matrix and assign as 'active' attribute vert.attr.nam[vert.attr.i]<-'active' values<-lapply(values,as.spells.pajek) } } temp <- set.vertex.attribute(temp,vert.attr.nam[vert.attr.i], values) } } else { #not a factor, set the attribute and don't convert to character temp <- set.vertex.attribute(temp,vert.attr.nam[vert.attr.i], vertex[as.numeric(vertex[,1]),vert.attr.i]) } if (verbose) print(paste(' set vertex attribute',vert.attr.nam[vert.attr.i])) } } } else { stop('number of rows in vertex data does not match number of vertices') } } # end vertex data processing # process edge data if(!is.null(edgeData)){ if (ncol(edgeData)>3) { # number of columns > 3 means dyads have attributes edge.attr.nam <- c("from","to","weight",4:ncol(edgeData)) #temp names for rest # loop over each column of edge attributes for (edge.attr.i in 4:ncol(edgeData)){ e <- edgeData[,edge.attr.i] if (is.factor(e)){ # if it's a factor (non-numeric), then edge.attr.nam.tmp <- levels(e)[1] # see if the first factor is an attribute name if (edge.attr.nam.tmp=="") edge.attr.nam.tmp <- levels(e)[2] # in case of missing data if (nlevels(e)<=2&!is.na(match(edge.attr.nam.tmp, # check for match if # factors <=2 c("w","c","p","s","a","ap","l","lp","lr","lphi","lc","la","fos","font",'h1','h2','a1','k1','k2','a2')))) { edge.attr.nam[edge.attr.i+1] <- edge.attr.nam.tmp #if match, name the next column } else { #if not, set the attribute, converting to character (networks incompat w/factors) # spec says missing values should be filled in by row above values<-as.character(edgeData[,edge.attr.i]) missingVals<-which(values=='') while(length(missingVals)>0){ values[min(missingVals)]<-values[min(missingVals)-1] missingVals<-which(values=='') } # special processing: # if name is 'l' (line label) it needs to have possible enclosing quotes removed # check if it has brackets for time info, if so added if (length(grep('^\\[.+\\]$',values))>0) { isDynamic<-TRUE # if using pajeck time structure, just assign it if(time.format=='pajekTiming'){ edge.attr.nam[edge.attr.i]<-'pajekTiming' } else if (time.format =='networkDynamic'){ # if using nd, convert to spell matrix and assign as 'active' attribute edge.attr.nam[edge.attr.i]<-'active' values<-lapply(values,as.spells.pajek) } } if(edge.attr.nam[edge.attr.i] == 'l'){ values<-gsub('"','',values) } temp <- set.edge.attribute(temp,edge.attr.nam[edge.attr.i], values) } } else { #not a factor, set the attribute and don't convert to character temp <- set.edge.attribute(temp,edge.attr.nam[vert.attr.i], edgeData[,edge.attr.i]) } if (verbose) print(paste(' set edge attribute',edge.attr.nam[edge.attr.i])) } } } # end arc/edge data processing if(!is.null(network.title)){ temp <- set.network.attribute(temp, "title", network.title) # not sure if this should also be the edges relation? }else{ warning("null network title") } if(nrow(as.data.frame(stringsAsFactors=TRUE,vertex))== network.size(temp)){ #should i be doing this? why don't these numbers match all time temp <- set.vertex.attribute(temp,"vertex.names",as.character(vertex[as.numeric(vertex[,1]),2])) } # if it is a dynamic network and we are doing nD format, secretly give it the networkDynamic class if(isDynamic){ if(time.format=='networkDynamic'){ if(verbose) print(" network has dynamics and is assigned 'networkDynamic' class") # using this instead of the safer as.networkDynamic() to avoid adding Suggests dependency on networkDynamic class(temp)<-c('networkDynamic',class(temp)) } else { if(verbose) print(' network has dynamic info which was saved without interpretation. see argument "time.format" for details') } } networks[[i]] <- temp if (verbose) print(paste("processed and added",network.names[i],"to list of networks")) } names(networks) <- network.names if(nnetworks > 1){ networks <- list(formula = ~1, networks = networks, stats = numeric(0),coef=0) class(networks) <- "network.series" } else{ networks <- networks[[1]] } projNames<-names(projects) projects <- c(projects,list(networks)) names(projects) <-c(projNames, network.title) return(projects) } # reads a single line of a file, splits it into tokens on ' ' and returns as string vector readAndVectorizeLine <- function(file){ line <- readLines(file, 1, ok = TRUE) if(!inherits(line,"try-error") & length(line)>0){ line <- strsplit(line," ")[[1]] line <- line[line!=""] } line } read.paj.simplify <- function(x,file,verbose=FALSE) { classx <- class(x) if(inherits(x,"network")){ cat(paste(file," is a single network object.\n",sep="")) assign(file,x) save(list=file, file=paste(file,".RData",sep="")) cat(paste("network saved as a 'network' object in ",file,".RData.\n",sep="")) return(x) } if(inherits(x,"network.series")){ nnets <- length(x$networks) cat(paste(file," is a set of ",nnets," networks on the same set of nodes.\n",sep="")) cat(paste("The network names are:\n ", paste(names(x$networks),collapse="\n "),"\n",sep="")) cnames <- names(x$networks) if(length(cnames) == 1){ assign(cnames,x$networks[[1]]) save(list=cnames, file=paste(file,".RData",sep="")) cat(paste("network simplified to a network object.\n",sep="")) cat(paste("network saved as a 'network' object in ",file,".RData.\n",sep="")) return(x$networks[[1]]) }else{ assign(file,x) save(list=file, file=paste(file,".RData",sep="")) cat(paste("network saved as a 'network.series' object in ",file,".RData.\n",sep="")) return(x) } } if(classx=="list"){ ncollects <- length(x$networks) nnets <- length(x$networks) npart <- length(x$partitions) cnames <- names(x$networks) if(length(cnames) > 1){ cat(paste(file," is a set of ",ncollects," collections of networks\n", "as well as Pajek 'partiton' information.\n",sep="")) cat(paste("The collection names are:\n ", paste(cnames,collapse="\n "),"\n",sep="")) for(i in seq(along=cnames)){ thisnet <- x$networks[[i]] classthisnet <- class(thisnet) if(inherits(thisnet,"network.series") & length(thisnet$networks)==1){ thisnet <- thisnet$networks[[1]] classthisnet <- class(thisnet) } if(inherits(thisnet,"network")){ cat(paste("The collection ",cnames[i]," is a single network object.\n", sep="")) }else{ cat(paste("The collection ",cnames[i], " is a set of networks on the same nodes.\n",sep="")) cat(paste("The network names are:\n ", paste(names(thisnet$networks),collapse="\n "),"\n",sep="")) } } cat(paste("There are ",npart," partitions on the networks.\n",sep="")) cat(paste("The partition names are:\n ", paste(names(x$partitions),collapse="\n "),"\n",sep="")) cat(paste(".RData file unchanged.\n",sep="")) }else{ thisnet <- x$networks[[1]] classthisnet <- class(thisnet) if(inherits(thisnet,"network")){ cat(paste(file," is a single network object called ", cnames,"\n", "as well as Pajek 'partiton' information.\n",sep="")) cat(paste("There are ",npart," partitions on the networks.\n",sep="")) cat(paste("The partition names are:\n ", paste(names(x$partitions),collapse="\n "),"\n",sep="")) }else{ cat(paste(file," is a collection of networks called ", cnames,"\n", "as well as Pajek 'partiton' information.\n",sep="")) cat(paste("The network names are:\n ", paste(names(thisnet$networks),collapse="\n "),"\n",sep="")) cat(paste("There are ",npart," partitions on the networks.\n",sep="")) cat(paste("The partition names are:\n ", paste(names(x$partitions),collapse="\n "),"\n",sep="")) } assign(cnames,x$networks[[1]]) assign(paste(cnames,"partitions",sep="."),x$partitions) save(list=c(cnames, paste(cnames,"partitions",sep=".")), file=paste(file,".RData",sep="")) if(inherits(x$networks[[1]],"network")){ cat(paste("network simplified to a 'network' object plus partition.\n",sep="")) cat(paste("network saved as a 'network' object and a separate partition list in ",file,".RData.\n",sep="")) }else{ cat(paste("network simplified to a 'network.series' object plus partition.\n",sep="")) cat(paste("network saved as a 'network.series' object and a separate partition list in ",file,".RData.\n",sep="")) } } } return(x) } # swaps the first two columns (tail, heads) in a matrix switchArcDirection <- function(edgelist){ edgelist[,1:2] <- edgelist[,2:1] edgelist } # return a character matrix with number of rows equal to length of list x # and ncol = longest element in x # assumes that list elements may not be all the same length # each row is filled in fro fillMatrixFromListRows<-function(x){ maxLen<-max(sapply(x,length)) paddedRows<-lapply(x,function(r){ row<-rep('',maxLen) row[1:length(r)]<-unlist(r) row }) return(do.call(rbind,paddedRows)) } # convert strings in pajek's timing notation into a spell matrix # example "[5-10,12-14]", "[1-3,7]", "[4-*]" # does not check spells for correctness of spell definitions as.spells.pajek <-function(pajekTiming,assume.discrete=TRUE){ # strip off brackets p<-gsub('\\[','',pajekTiming) p<-gsub('\\]','',p) # split on comma splStrings<-strsplit(p,',') spls<-sapply(splStrings[[1]],function(s){ # default always active spl<-c(-Inf,Inf) elements<-strsplit(s,'-')[[1]] if(length(elements)==2){ # replace Infs if (elements[1]=='*'){ elements[1]<-'-Inf' } if (elements[2]=='*'){ elements[2]<-'Inf' } # convert to numeric and form spell spl<-c(as.numeric(elements[1]),as.numeric(elements[2])) } else if (length(elements)==1){ # only one element, so duplicate spl[1:2]<-as.numeric(elements[1]) } else { stop('unable to parse token: ',s) } if (assume.discrete){ # add one time unit to the ending value to conform with networkDynamic's 'until' spell definition spl[2]<-spl[2]+1 } return(spl) }) # reshape vector of spell data into a 2-column matrix return(matrix(spls,ncol=2,byrow=TRUE)) } network/R/network-package.R0000644000176200001440000004440514057075374015374 0ustar liggesusers#' @useDynLib network, .registration = TRUE #' @import utils #' @importFrom grDevices colors gray #' @importFrom graphics locator par plot polygon rect strheight strwidth text #' @importFrom stats rnorm na.omit #' @importFrom tibble tibble as.tibble as_tibble #' @importFrom magrittr %>% set_names NULL #' Interorganizational Search and Rescue Networks (Drabek et al.) #' #' Drabek et al. (1981) provide seven case studies of emergent #' multi-organizational networks (EMONs) in the context of search and rescue #' (SAR) activities. Networks of interaction frequency are reported, along #' with several organizational attributes. #' #' All networks collected by Drabek et al. reflect reported frequency of #' organizational interaction during the search and rescue effort; the (i,j) #' edge constitutes i's report regarding interaction with j, with non-adjacent #' vertices reporting no contact. Frequency is rated on a four-point scale, #' with 1 indicating the highest frequency of interaction. (Response options: #' 1=\dQuote{continuously}, 2=\dQuote{about once an hour}, 3=\dQuote{every few #' hours}, 4=\dQuote{about once a day or less}) This is stored within the #' \code{"Frequency"} edge attribute. #' #' For each network, several covariates are recorded as vertex attributes: #' #' \describe{ #' \item{Command.Rank.Score}{ Mean (reversed) rank for the #' prominence of each organization in the command structure of the response, as #' judged by organizational informants.} #' \item{Decision.Rank.Score}{ Mean (reversed) rank for the #' prominence of each organization in decision making #' processes during the response, as judged by organizational informants.} #' \item{Formalization}{ An index of organizational formalization, ranging from #' 0 (least formalized) to 4 (most formalized).} \item{Localization}{ For each #' organization, \code{"L"} if the organization was sited locally to the impact #' area, \code{"NL"} if the organization was not sited near the impact area, #' \code{"B"} if the organization was sited at both local and non-local #' locations.} #' \item{Paid.Staff}{ Number of paid staff employed by each #' organization at the time of the response.} #' \item{Sponsorship}{ The level at which each organization #' was sponsored (e.g., \code{"City"}, \code{"County"}, #' \code{"State"}, \code{"Federal"}, and \code{"Private"}).} #' \item{vertex.names}{ The identity of each organization.} #' \item{Volunteer.Staff}{ Number of volunteer staff employed by each #' organization at the time of the response.} #' } #' #' Note that where intervals were given by the original source, midpoints have #' been substituted. For detailed information regarding data coding and #' procedures, see Drabek et al. (1981). #' #' @name emon #' @docType data #' @usage data(emon) #' @format A list of 7 \code{\link{network}} objects: #' #' \tabular{rlll}{ #' `[[1]]` \tab Cheyenne \tab network \tab Cheyenne SAR EMON\cr #' `[[2]]` \tab HurrFrederic \tab network \tab Hurricane Frederic SAR EMON\cr #' `[[3]]` \tab LakePomona \tab network \tab Lake Pomona SAR EMON\cr #' `[[4]]` \tab MtSi \tab network \tab Mt. Si SAR EMON\cr #' `[[5]]` \tab MtStHelens \tab network \tab Mt. St. Helens SAR EMON\cr #' `[[6]]` \tab Texas \tab network \tab Texas Hill Country SAR EMON\cr #' `[[7]]` \tab Wichita \tab network \tab Wichita Falls SAR EMON #' } #' #' Each network has one edge attribute: #' #' \tabular{lll}{ Frequency \tab numeric \tab Interaction frequency (1-4; #' 1=most frequent) } #' #' Each network also has 8 vertex attributes: #' #' \tabular{lll}{ #' Command.Rank.Score \tab numeric \tab Mean rank in the command structure\cr #' Decision.Rank.Score \tab numeric \tab Mean rank in the decision process\cr #' Formalization \tab numeric \tab Degree of formalization\cr #' Location \tab character \tab Location code\cr #' Paid.Staff \tab numeric \tab Number of paid staff\cr #' Sponsorship \tab character \tab Sponsorship type\cr #' vertex.names \tab character \tab Organization name\cr #' Volunteer.Staff \tab numeric \tab Number of volunteer staff #' } #' #' @seealso \code{\link{network}} #' @source Drabek, T.E.; Tamminga, H.L.; Kilijanek, T.S.; and Adams, C.R. #' (1981). \emph{Data from Managing Multiorganizational Emergency Responses: #' Emergent Search and Rescue Networks in Natural Disaster and Remote Area #' Settings.} Program on Technology, Environment, and Man Monograph 33. #' Institute for Behavioral Science, University of Colorado. #' @keywords datasets #' @examples #' #' data(emon) #Load the emon data set #' #' #Plot the EMONs #' par(mfrow=c(3,3)) #' for(i in 1:length(emon)) #' plot(emon[[i]],main=names(emon)[i],edge.lwd="Frequency") #' NULL #' Florentine Wedding Data (Padgett) #' #' This is a data set of Padgett (1994), consisting of weddings among leading #' Florentine families. This data is stored in symmetric adjacency matrix #' form. #' #' @name flo #' @usage data(flo) #' @seealso \code{\link{network}} #' @references Wasserman, S. and Faust, K. (1994) \emph{Social Network #' Analysis: Methods and Applications}, Cambridge: Cambridge University Press. #' @source Padgett, John F. (1994). \dQuote{Marriage and Elite Structure in #' Renaissance Florence, 1282-1500.} Paper delivered to the Social Science #' History Association. #' @keywords datasets #' @examples #' #' data(flo) #' nflo<-network(flo,directed=FALSE) #Convert to network object form #' all(nflo[,]==flo) #Trust, but verify #' #A fancy display: #' plot(nflo,displaylabels=TRUE,boxed.labels=FALSE,label.cex=0.75) #' NULL #' Examples of how to load vertex and edge attributes into networks #' #' Additional examples of how to manipulate network attributes using the #' functions documented in \code{\link{attribute.methods}} #' #' The \code{\link{attribute.methods}} documentation gives details about the #' use of the specific network attribute methods such as #' \code{get.vertex.attribute} and \code{set.edge.attribute}. This document #' gives examples of how to load in and attach attribute data, drawing heavily #' on material from the Sunbelt statnet workshops #' \url{https://github.com/statnet/Workshops/wiki}. #' #' The examples section below give a quick overview of: #' \itemize{ #' \item Loading in a matrix #' #' \item Attaching vertex attributes #' #' \item Attaching edge atributes from a matrix #' #' \item Loading in an edgelist #' #' \item Attaching edge atributes from an edgelist #' } #' #' The \code{\link{read.table}} documentation provides more information about #' reading data in from various tabular file formats prior to loading into a #' network. Note that the output is usually a \code{\link{data.frame}} object #' in which each columns is represented as a \code{\link{factor}}. This means #' that in some cases when the output is directly loaded into a network the #' variable values will appear as factor level numbers instead of text values. #' The \code{stringsAsFactors=FALSE} flag may help with this, but some columns #' may need to be converted using \code{as.numeric} or \code{as.character} #' where appropriate. #' #' @name loading.attributes #' #' @seealso \code{\link{attribute.methods}}, \code{\link{as.network.matrix}}, #' \code{\link{as.sociomatrix}}, \code{\link{as.matrix.network}}, #' \code{\link{network.extraction}} #' @references Acton, R. M., Jasny, L (2012) \emph{An Introduction to Network #' Analysis with R and statnet} Sunbelt XXXII Workshop Series, March 13, 2012. #' #' Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational #' Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @keywords classes graphs #' @examples #' #' #' # read in a relational data adjacency matrix #' #' # LOADING IN A MATRIX #' \dontrun{ #' # can download matrix file from #' # https://statnet.csde.washington.edu/trac/raw-attachment/wiki/Resources/relationalData.csv #' # and download vertex attribute file from #' # https://statnet.csde.washington.edu/trac/raw-attachment/wiki/Resources/vertexAttributes.csv #' #' # load in relation matrix from file #' relations <- read.csv("relationalData.csv",header=FALSE,stringsAsFactors=FALSE) #' #' # convert to matrix format from data frame #' relations <- as.matrix(relations) #' #' # load in vertex attributes #' nodeInfo <- read.csv("vertexAttributes.csv",header=TRUE,stringsAsFactors=FALSE) #' } #' \dontshow{ #' # since no access to file, creating it here #' relations <- matrix( #' c(0,0,0,1,1,1,0,0,0, #' 0,0,0,0,0,1,0,0,0, #' 0,0,0,0,0,0,1,0,1, #' 1,0,0,0,1,0,0,0,0, #' 1,0,0,1,0,0,0,0,0, #' 1,1,0,0,0,0,0,0,1, #' 0,0,1,0,0,0,0,0,1, #' 0,0,0,0,0,0,0,0,0, #' 0,0,1,0,0,1,1,0,0),ncol=9,byrow=TRUE) #' #' nodeInfo <- data.frame( #' name=c("Danielle","Josh","Mark","Emma","Sarah","Dave","Theresa","Carolyn","Gil"), #' age=c(44,44,40,32,33,36,38,42,30), #' sex=c("F","M","M","F","F","M","F","F","M"), #' handed=c("R","R","R","L","R","L","L","R","L"), #' lastDocVisit=c(2012,2008,2010,2012,2011,2007,2009,2009,2010), #' stringsAsFactors=FALSE #' ) #' } #' #' print(relations) # peek at matrix #' print(nodeInfo) # peek at attribute data #' #' # Since our relational data has no row/column names, let's set them now #' rownames(relations) <- nodeInfo$name #' colnames(relations) <- nodeInfo$name #' #' # create undirected network object from matrix #' nrelations<-network(relations,directed=FALSE) #' #' # it read in vertex names from matrix col names ... #' network.vertex.names(nrelations) #' #' # ATTACHING VERTEX ATTRIBUTES #' #' # ... but could also set vertex.names with #' nrelations%v%'vertex.names'<- nodeInfo$name #' #' # load in other attributes #' nrelations%v%"age" <- nodeInfo$age #' nrelations%v%"sex" <- nodeInfo$sex #' nrelations%v%"handed" <- nodeInfo$handed #' nrelations%v%"lastDocVisit" <- nodeInfo$lastDocVisit #' #' # Note: order of attributes in the data frame MUST match vertex ids #' # otherwise the attribute will get assigned to the wrong vertex #' #' # check that they got loaded #' list.vertex.attributes(nrelations) #' #' #' # what if we had an adjaceny matrix like: #' valuedMat<-matrix(c(1,2,3, 2,0,9.5,1,5,0),ncol=3,byrow=TRUE) #' valuedMat #' #' # make a network from it #' valuedNet<-network(valuedMat,loops=TRUE,directed=TRUE) #' #' # print it back out ... #' as.matrix(valuedNet) #' #' # wait, where did the values go!!? #' #' # LOADING A MATRIX WITH VALUES #' #' # to construct net from matrix with values: #' valuedNet<-network(valuedMat,loops=TRUE,directed=TRUE, #' ignore.eval=FALSE,names.eval='myEdgeWeight') #' #' # also have to specify the name of the attribute when converting to matrix #' as.matrix(valuedNet,attrname='myEdgeWeight') #' #' # ATTACHING EDGE ATTRIBUTES FROM A MATRIX #' #' # maybe we have edge attributes of a different sort in another matrix like: #' edgeAttrs<-matrix(c("B","Z","Q","W","A","E","L","P","A"),ncol=3,byrow=TRUE) #' edgeAttrs #' #' # we can still attach them #' valuedNet<-set.edge.value(valuedNet,'someLetters',edgeAttrs) #' #' # and extract them #' as.matrix(valuedNet,attrname='someLetters') #' valuedNet%e%'someLetters' #' #' # but notice that some of the values didn't get used #' # the ("A"s are missing) because there were no corresponding edges (loops) #' # for the attribute to be attached to #' #' #' # ATTACHING EDGE ATTRIBUTES FROM A LIST #' #' # it is also possible to attach edge attributes directly from a list #' edgeCols<-c("red","green","blue","orange","pink","brown","gray") #' valuedNet<-set.edge.attribute(valuedNet,"edgeColors",edgeCols) #' #' # but this can be risky, because we may not know the ordering of the edges, #' # (especially if some have been deleted). Does "green" go with the edge from #' # 1 to 2, or from 3 to 1? #' #' # Usually if the edge data is only availible in list form, it is safer to construct #' # the network from an edgelist in the first place #' #' # LOADING IN AN EDGELIST #' #' # pretend we just loaded in this data.frame from a file #' elData<-data.frame( #' from_id=c("1","2","3","1","3","1","2"), #' to_id=c("1", "1", "1", "2", "2", "3", "3"), #' myEdgeWeight=c(1, 2, 1, 2, 5, 3, 9.5), #' someLetters=c("B", "W", "L", "Z", "P", "Q", "E"), #' edgeCols=c("red","green","blue","orange","pink","brown","gray"), #' stringsAsFactors=FALSE #' ) #' #' # peek at data #' # each row corresponds to a relationship (edge) in the network #' elData #' #' # to make a network we just use the first two id columns #' valuedNet2<-network(elData[,1:2],loops=TRUE) #' #' # print it out #' as.matrix(valuedNet2) #' #' # has right edges, but no values #' #' # to include values (with names from the columns) #' #' valuedNet2<-network(elData,loops=TRUE) #' list.edge.attributes(valuedNet2) #' as.matrix(valuedNet2,attrname='someLetters') #' #' NULL #' Classes for Relational Data #' #' Tools to create and modify network objects. The network class can represent #' a range of relational data types, and supports arbitrary vertex/edge/graph #' attributes. #' #' The \code{network} package provides tools for creation, access, and #' modification of \code{network} class objects. These objects allow for the #' representation of more complex structures than can be readily handled by #' other means (e.g., adjacency matrices), and are substantially more efficient #' in handling large, sparse networks. While the full capabilities of the #' \code{network} class can only be exploited by means of the various custom #' interface methods (see below), many simple tasks are streamlined through the #' use of operator overloading; in particular, network objects can often be #' treated as if they were adjacency matrices (a representation which will be #' familiar to users of the \code{sna} package). \code{network} objects are #' compatible with the \code{sna} package, and are required for many packages #' in the \code{statnet} bundle. #' #' Basic information on the creation of \code{network} objects can be found by #' typing \code{help(network)}. To learn about setting, modifying, or deleting #' network, vertex, or edge attributes, see \code{help(attribute.methods)}. #' For information on custom network operators, type #' \code{help(network.operators)}; information on overloaded operators can be #' found via \code{help(network.extraction)}. Additional help topics are #' listed below. #' #' \tabular{ll}{ #' Package: \tab network\cr #' Version: \tab 1.14\cr #' Date: \tab May 7, 2016\cr #' Depends: \tab R (>= 2.10), utils\cr #' Suggests: \tab sna, statnet.common (>= 3.1-0)\cr #' License: \tab GPL (>=2)\cr #' } #' #' Index of documentation pages: #' \preformatted{ #' add.edges Add Edges to a Network Object #' add.vertices Add Vertices to an Existing Network #' as.matrix.network Coerce a Network Object to Matrix Form #' as.network.matrix Coercion from Matrices to Network Objects #' as.sociomatrix Coerce One or More Networks to Sociomatrix Form #' attribute.methods Attribute Interface Methods for the Network #' Class #' deletion.methods Remove Elements from a Network Object #' edgeset.constructors Edgeset Constructors for Network Objects #' emon Interorganizational Search and Rescue Networks #' (Drabek et al.) #' flo Florentine Wedding Data (Padgett) #' get.edges Retrieve Edges or Edge IDs Associated with a #' Given Vertex #' get.inducedSubgraph Retrieve Induced Subgraphs and Cuts #' get.neighborhood Obtain the Neighborhood of a Given Vertex #' is.adjacent Determine Whether Two Vertices Are Adjacent #' loading.attributes Examples of how to load vertex and edge #' attributes into networks #' missing.edges Identifying and Counting Missing Edges in a #' Network Object #' network Network Objects #' network.arrow Add Arrows or Segments to a Plot #' network.density Compute the Density of a Network #' network.dyadcount Return the Number of (Possibly Directed) Dyads #' in a Network Object #' network.edgecount Return the Number of Edges in a Network Object #' network.edgelabel Plots a label corresponding to an edge in a #' network plot. #' network.extraction Extraction and Replacement Operators for #' Network Objects #' network.indicators Indicator Functions for Network Properties #' network.initialize Initialize a Network Class Object #' network.layout Vertex Layout Functions for plot.network #' network.loop Add Loops to a Plot #' network.operators Network Operators #' network-package Classes for Relational Data #' network.size Return the Size of a Network #' network.vertex Add Vertices to a Plot #' permute.vertexIDs Permute (Relabel) the Vertices Within a Network #' plotArgs.network Expand and transform attributes of networks to #' values appropriate for aguments to plot.network #' plot.network.default Two-Dimensional Visualization for Network #' Objects #' prod.network Combine Networks by Edge Value Multiplication #' read.paj Read a Pajek Project or Network File and #' Convert to an R 'Network' Object #' sum.network Combine Networks by Edge Value Addition #' valid.eids Get the valid edge which are valid in a network #' which.matrix.type Heuristic Determination of Matrix Types for #' Network Storage #' } #' #' #' @name network-package #' @docType package #' @author Carter T. Butts , with help from Mark S. Handcock #' , David Hunter , Martina #' Morris , Skye Bender-deMoll #' , and Jeffrey Horner #' . #' #' Maintainer: Carter T. Butts #' @keywords package NULL network/R/constructors.R0000644000176200001440000003757114060055611015052 0ustar liggesusers###################################################################### # # constructors.R # # Written by Carter T. Butts ; portions contributed by # David Hunter and Mark S. Handcock # . # # Last Modified 06/08/21 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains various routines for the construction of network # and edge objects. # # Contents: # # network # network.adjacency # network.copy # network.edgelist # network.incidence # network.initialize # ###################################################################### # Basic network constructor. Converts a single matrix to a network class # object. The matrix must be in one of three formats: adjacency, # incidence, or edgelist. # # MSH added bipartite # #' @rdname network #' @export network network<-function(x, vertex.attr=NULL, vertex.attrnames=NULL, directed=TRUE, hyper=FALSE, loops=FALSE, multiple=FALSE, bipartite=FALSE, ...) { #Initialize the network object g<-as.network(x,directed=directed,hyper=hyper,loops=loops, multiple=multiple,bipartite=bipartite,...) #Add vertex attributes, if needed if(!is.null(vertex.attr)){ #Create vertex attribute names, if needed if(is.null(vertex.attrnames)){ if(!is.null(names(vertex.attr))) vertex.attrnames<-names(vertex.attr) else{ vertex.attrnames<-1:length(vertex.attr) warning("Vertex attribute names not given; making some up.") } } #Add the attributes for(i in 1:length(vertex.attr)) g<-set.vertex.attribute(g,vertex.attrnames[[i]],vertex.attr[[i]]) } # xnames <- get.vertex.attribute(g,"vertex.names") # if(!is.null(xnames) & any(!is.na(xnames))){ g <- xnames } #Return the result g } # Construct a network's edge set, using an a bipartite adjacency matrix as input. # #' @name edgeset.constructors #' #' @title Edgeset Constructors for Network Objects #' #' @description These functions convert relational data in matrix form to #' network edge sets. #' #' @details Each of the above functions takes a \code{network} and a matrix #' as input, and modifies the supplied \code{network} object by adding the #' appropriate edges. \code{network.adjacency} takes \code{x} to be an #' adjacency matrix; \code{network.edgelist} takes \code{x} to be an edgelist #' matrix; and \code{network.incidence} takes \code{x} to be an incidence #' matrix. \code{network.bipartite} takes \code{x} to be a two-mode #' adjacency matrix where rows and columns reflect each respective mode #' (conventionally, actors and events); If \code{ignore.eval==FALSE}, #' (non-zero) edge values are stored as edgewise attributes with name #' \code{names.eval}. The \code{edge.check} argument can be added via #' \code{\dots} and will be passed to \code{\link{add.edges}}. #' #' Edgelist matrices to be used with \code{network.edgelist} should have one #' row per edge, with the first two columns indicating the sender and #' receiver of each edge (respectively). Edge values may be provided in #' additional columns. The edge attributes will be created with names #' corresponding to the column names unless alternate names are provided via #' \code{names.eval}. The vertices specified in the first two columns, which #' can be characters, are added to the network in default sort order. The #' edges are added in the order specified by the edgelist matrix. #' #' Incidence matrices should contain one row per vertex, with one column per #' edge. A non-zero entry in the matrix means that the edge with the id #' corresponding to the column index will have an incident vertex with an #' id corresponding to the row index. In the directed case, negative cell #' values are taken to indicate tail vertices, while positive values #' indicate head vertices. #' #' Results similar to \code{network.adjacency} can also be obtained by means #' of extraction/replacement operators. See the associated man page for #' details. #' #' @param x a matrix containing edge information #' @param g an object of class \code{network} #' @param ignore.eval logical; ignore edge value information in x? #' @param names.eval a name for the edge attribute under which to store edge #' values, if any #' @param \dots possible additional arguments (such as \code{edge.check}) #' #' @return Invisibly, an object of class \code{network}; these functions modify #' their argument in place. #' #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' #' @author Carter T. Butts \email{buttsc@uci.edu} and David Hunter #' \email{dhunter@stat.psu.edu} #' #' #' @seealso \code{\link{loading.attributes}}, \code{\link{network}}, #' \code{\link{network.initialize}}, \code{\link{add.edges}}, #' \code{\link{network.extraction}} #' @examples #' #Create an arbitrary adjacency matrix #' m<-matrix(rbinom(25,1,0.5),5,5) #' diag(m)<-0 #' #' g<-network.initialize(5) #Initialize the network #' network.adjacency(m,g) #Import the edge data #' #' #Do the same thing, using replacement operators #' g<-network.initialize(5) #' g[,]<-m #' #' # load edges from a data.frame via network.edgelist #' edata <-data.frame( #' tails=c(1,2,3), #' heads=c(2,3,1), #' love=c('yes','no','maybe'), #' hate=c(3,-5,2), #' stringsAsFactors=FALSE #' ) #' #' g<-network.edgelist(edata,network.initialize(4),ignore.eval=FALSE) #' as.sociomatrix(g,attrname='hate') #' g%e%'love' #' #' # load edges from an incidence matrix #' inci<-matrix(c(1,1,0,0, 0,1,1,0, 1,0,1,0),ncol=3,byrow=FALSE) #' inci #' g<-network.incidence(inci,network.initialize(4,directed=FALSE)) #' as.matrix(g) #' #' #' #' #' @keywords classes graphs #' @export network.bipartite<-function(x, g, ignore.eval=TRUE, names.eval=NULL, ...){ #Set things up to edit g in place gn<-substitute(g) #Build head/tail lists; note that these cannot be hypergraphic or #multiplex, since our data is drawn from an adjacency matrix nactors <- dim(x)[1] nevents <- dim(x)[2] n <- nactors + nevents #Add names if available if(!is.null(colnames(x)) & !is.null(rownames(x))){ g <- set.vertex.attribute(g,"vertex.names",c(rownames(x),colnames(x))) } # convert x into a matrix x<-as.matrix(x) X <- matrix(0,ncol=n,nrow=n) # diag(X) <- 0 X[1:nactors, nactors+(1:nevents)] <- x X[nactors+(1:nevents), 1:nactors] <- t(x) X[row(X)0) add.edges(g, as.list(1+e%%n), as.list(1+e%/%n), names.eval=en, vals.eval=ev, ...) #Patch up g on exit for in-place modification if(.validLHS(gn,parent.frame())){ on.exit(eval.parent(call('<-',gn,g))) } invisible(g) } # Construct a network's edge set, using an adjacency matrix as input. # #' @rdname edgeset.constructors #' @export network.adjacency<-function(x, g, ignore.eval=TRUE, names.eval=NULL, ...){ # check that dimension of g is appropriate for x if (nrow(x)!=ncol(x)){ stop('the network.adjacency constructor expects its matrix argument to be square (same number of rows and columns)') } if (network.size(g) != nrow(x)){ stop('the network.adjacency constructor requires that the size of its network argument (',network.size(g),') matches the dimensions of the matrix argument (',nrow(x),' by ',ncol(x),')') } #Set things up to edit g in place gn<-substitute(g) #Build head/tail lists; note that these cannot be hypergraphic or #multiplex, since our data is drawn from an adjacency matrix if(!is.directed(g)){ missingE <- is.na(x) | is.na(t(x)) x[missingE] <- 1 #Be sure to pick up nonzero entries for which x[i,j]=-x[j,i]. x[x==-t(x)]<-abs(x)[x==-t(x)] x<-(x+t(x))/2 #Symmetrize matrix. x[row(x)0) add.edges(g, as.list(1+e%%n), as.list(1+e%/%n), names.eval=en, vals.eval=ev, ...) #Patch up g on exit for in-place modification if(.validLHS(gn,parent.frame())){ on.exit(eval.parent(call('<-',gn,g))) } invisible(g) } # Construct and a return a network object which is a copy of x # #' @rdname network #' @export network.copy<-function(x){ #Verify that this is a network object if(!is.network(x)) stop("network.copy requires an argument of class network.\n") #Duplicate and return y<-.Call(copyNetwork_R,x) y } # Construct a network's edge set, using an edgelist matrix as input. # #' @rdname edgeset.constructors #' @export network.edgelist<-function(x, g, ignore.eval=TRUE, names.eval=NULL, ...){ #Set things up to edit g in place gn<-substitute(g) l<-dim(x)[2] #Remove loops if has.loops==FALSE if((NROW(x)>0)&&(!has.loops(g))){ cn<-colnames(x) x<-x[x[,1]!=x[,2],,drop=FALSE] #Remove loops colnames(x)<-cn } #Remove redundant edges if is.multiplex==FALSE if((NROW(x)>0)&&(!is.multiplex(g))){ cn<-colnames(x) if(is.directed(g)){ x<-x[!duplicated(x[,1:2,drop=FALSE]),,drop=FALSE] }else{ x[,1:2]<-t(apply(x[,1:2,drop=FALSE],1,sort)) x<-x[!duplicated(x[,1:2,drop=FALSE]),,drop=FALSE] } colnames(x)<-cn } #Traverse the edgelist matrix, adding edges as we go. if((l>2)&&(!ignore.eval)){ #Use values if present... #if names not given, try to use the names from data frame if (is.null(names.eval)){ names.eval<-names(x)[3:l] } #if it is still null, its going to crash, so throw an informative error if (is.null(names.eval)){ stop("unable to add attribute values to edges because names are not provided for each attribute (names.eval=NULL)") } edge.check<-list(...)$edge.check eattrnames <-lapply(seq_len(NROW(x)),function(r){as.list(names.eval)}) # eattrvals <-apply(x[,3:l,drop=FALSE] eattrvals <-lapply(seq_len(NROW(x)),function(r){as.list(x[r,3:l,drop=FALSE])}) g<-add.edges(g,as.list(x[,1]),as.list(x[,2]),eattrnames,eattrvals,edge.check=edge.check) }else{ #...otherwise, don't. edge.check<-list(...)$edge.check g<-add.edges(g,as.list(x[,1]),as.list(x[,2]),edge.check=edge.check) } #Patch up g on exit for in-place modification if(.validLHS(gn,parent.frame())){ on.exit(eval.parent(call('<-',gn,g))) } invisible(g) } # Construct a network's edge set, using an incidence matrix as input. # #' @rdname edgeset.constructors #' @export network.incidence<-function(x, g, ignore.eval=TRUE, names.eval=NULL, ...){ #Set things up to edit g in place gn<-substitute(g) n<-network.size(g) edge.check<-list(...)$edge.check #Traverse the incidence matrix, adding edges as we go. for(i in 1:dim(x)[2]){ #Construct the head and tail sets if(is.directed(g)){ if(any(is.na(x[,i]))) stop("Missing data not allowed for directed incidence matrices.\n") head<-(1:n)[x[,i]>0] tail<-(1:n)[x[,i]<0] missing<-FALSE }else{ missing<-any(is.na(x[,i])) x[,i][is.na(x[,i])]<-1 head<-(1:n)[x[,i]!=0] if(is.hyper(g)) tail<-head else{ #If dyadic, use only the first two nonzero entries tail<-head[1] head<-head[2] } } if(length(head)*length(tail)==0) stop("Supplied incidence matrix has empty head/tail lists. (Did you get the directedness right?)") #Get edge values, if needed if(ignore.eval){ en<-"na" ev<-missing }else{ if(!is.directed(g)) ev<-list(missing,x[x[,i]!=0,i][1]) else ev<-list(missing,abs(x[x[,i]!=0,i][1])) if(is.null(names.eval)) en<-list("na",NULL) else en<-list("na",names.eval) } #Add the edge to the graph g<-add.edge(g,tail,head,names.eval=en,vals.eval=ev,edge.check=edge.check) } #Patch up g on exit for in-place modification if(.validLHS(gn,parent.frame())){ on.exit(eval.parent(call('<-',gn,g))) } invisible(g) } # Initialize a new network object. # MSH added bipartite # #' Initialize a Network Class Object #' #' Create and initialize a \code{network} object with \code{n} vertices. #' #' Generally, \code{network.initialize} is called by other constructor #' functions as part of the process of creating a network. #' #' @param n the number of vertices to initialize #' @param directed logical; should edges be interpreted as directed? #' @param hyper logical; are hyperedges allowed? #' @param loops logical; should loops be allowed? #' @param multiple logical; are multiplex edges allowed? #' @param bipartite count; should the network be interpreted as bipartite? If #' present (i.e., non-NULL) it is the count of the number of actors in the #' first mode of the bipartite network. In this case, the overall number of #' vertices is equal to the number of 'actors' (first mode) plus the number of #' `events' (second mode), with the vertex.ids of all actors preceeding all #' events. The edges are then interpreted as nondirected. #' @return An object of class \code{network} #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network}}, \code{\link{as.network.matrix}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @keywords classes graphs #' @examples #' #' g<-network.initialize(5) #Create an empty graph on 5 vertices #' #' @export network.initialize network.initialize<-function(n,directed=TRUE,hyper=FALSE,loops=FALSE,multiple=FALSE,bipartite=FALSE){ #If we have a negative number of vertices, we have a problem... n<-round(n) if(n<0) stop("Network objects cannot be of negative order.") #Create the base-level lists g<-list() g$mel<-list() g$gal<-list() #Create the required network attributes g$gal$n<-n g$gal$mnext<-1 g$gal$directed<-directed g$gal$hyper<-hyper g$gal$loops<-loops g$gal$multiple<-multiple g$gal$bipartite<-bipartite #Populate the vertex attribute lists, endpoint lists, etc. if(n>0){ g$val<-rep(list(list()), n) g$iel<-rep(list(integer()), n) g$oel<-rep(list(integer()), n) }else{ g$val<-vector(length=0,mode="list") g$iel<-vector(length=0,mode="list") g$oel<-vector(length=0,mode="list") } #Set the class class(g)<-"network" #Set the required vertex attribute if(n>0) g<-set.vertex.attribute(g,"na",rep(FALSE,n),1:n) #Create default vertex names if(n>0) network.vertex.names(g)<-1:n #Return g } network/R/layout.R0000644000176200001440000002617414057075374013632 0ustar liggesusers###################################################################### # # layout.R # # Written by Carter T. Butts ; portions contributed by # David Hunter and Mark S. Handcock # . # # Last Modified 06/06/21 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains various routines related to vertex layouts (for # graph drawing). These are currently ported directly from the sna # package for R (Carter T. Butts ). # # Contents: # # network.layout.circle # network.layout.fruchtermanreingold # network.layout.kamadakawaii # ###################################################################### #Place vertices in a circular layout (for plot.network) #' Vertex Layout Functions for plot.network #' #' Various functions which generate vertex layouts for the #' \code{\link{plot.network}} visualization routine. #' #' Vertex layouts for network visualization pose a difficult problem -- there #' is no single, ``good'' layout algorithm, and many different approaches may #' be valuable under different circumstances. With this in mind, #' \code{\link{plot.network}} allows for the use of arbitrary vertex layout #' algorithms via the \code{network.layout.*} family of routines. When called, #' \code{\link{plot.network}} searches for a \code{network.layout} function #' whose fourth name matches its \code{mode} argument (see #' \code{\link{plot.network}} help for more information); this function is then #' used to generate the layout for the resulting plot. In addition to the #' routines documented here, users may add their own layout functions as #' needed. The requirements for a \code{network.layout} function are as #' follows: #' \enumerate{ #' \item the first argument, \code{nw}, must be a network object; #' \item the second argument, \code{layout.par}, must be a list of parameters #' (or \code{NULL}, if no parameters are specified); and #' \item the return value must be a real matrix of dimension \code{c(2,network.size(nw))}, #' whose rows contain the vertex coordinates. #' } #' Other than this, anything goes. (In particular, note that \code{layout.par} #' could be used to pass additional matrices or other information, if needed. #' Alternately, it is possible to make layout methods that respond to #' covariates on the network object, which are maintained intact by #' plot.network.) #' #' The \code{network.layout} functions currently supplied by default are as #' follows (with \code{n==network.size(nw)}): #' \describe{ #' \item{circle}{ This function places vertices uniformly in a circle; it takes no arguments.} #' \item{fruchtermanreingold}{ This function generates a layout using a variant of Fruchterman and Reingold's force-directed placement algorithm. It takes the following arguments: #' \describe{ #' \item{layout.par$niter}{ This argument controls the number of iterations to be employed. Larger values take longer, but will provide a more refined layout. (Defaults to 500.) } #' \item{layout.par$max.delta}{ Sets the maximum change in position for any given iteration. (Defaults to \code{n}.)} #' \item{layout.par$area}{ Sets the "area" parameter for the F-R algorithm. (Defaults to \code{n^2}.)} #' \item{layout.par$cool.exp}{ Sets the cooling exponent for the annealer. (Defaults to 3.)} #' \item{layout.par$repulse.rad}{ Determines the radius at which vertex-vertex repulsion cancels out attraction of adjacent vertices. (Defaults to \code{area*log(n)}.)} #' \item{layout.par$ncell}{ To speed calculations on large graphs, the plot region is divided at each iteration into \code{ncell} by \code{ncell} \dQuote{cells}, which are used to define neighborhoods for force calculation. Moderate numbers of cells result in fastest performance; too few cells (down to 1, which produces \dQuote{pure} F-R results) can yield odd layouts, while too many will result in long layout times. (Defaults to \code{n^0.4}.)} #' \item{layout.par$cell.jitter}{ Jitter factor (in units of cell width) used in assigning vertices to cells. Small values may generate \dQuote{grid-like} anomalies for graphs with many isolates. (Defaults to \code{0.5}.)} #' \item{layout.par$cell.pointpointrad}{ Squared \dQuote{radius} (in units of cells) such that exact point interaction calculations are used for all vertices belonging to any two cells less than or equal to this distance apart. Higher values approximate the true F-R solution, but increase computational cost. (Defaults to \code{0}.)} #' \item{layout.par$cell.pointcellrad}{ Squared \dQuote{radius} (in units of cells) such that approximate point/cell interaction calculations are used for all vertices belonging to any two cells less than or equal to this distance apart (and not within the point/point radius). Higher values provide somewhat better approximations to the true F-R solution at slightly increased computational cost. (Defaults to \code{18}.)} #' \item{layout.par$cell.cellcellrad}{ Squared \dQuote{radius} (in units of cells) such that approximate cell/cell interaction calculations are used for all vertices belonging to any two cells less than or equal to this distance apart (and not within the point/point or point/cell radii). Higher values provide somewhat better approximations to the true F-R solution at slightly increased computational cost. Note that cells beyond this radius (if any) do not interact, save through edge attraction. (Defaults to \code{ncell^2}.)} #' \item{layout.par$seed.coord}{ A two-column matrix of initial vertex coordinates. (Defaults to a random circular layout.) } #' } #' } #' \item{kamadakawai}{ This function generates a vertex layout using a version of the Kamada-Kawai force-directed placement algorithm. It takes the following arguments: #' \describe{ #' \item{layout.par$niter}{ This argument controls the number of iterations to be employed. (Defaults to 1000.) } #' \item{layout.par$sigma}{ Sets the base standard deviation of position change proposals. (Defaults to \code{n/4}.)} #' \item{layout.par$initemp}{ Sets the initial "temperature" for the annealing algorithm. (Defaults to 10.)} #' \item{layout.par$cool.exp}{ Sets the cooling exponent for the annealer. (Defaults to 0.99.)} #' \item{layout.par$kkconst}{ Sets the Kamada-Kawai vertex attraction constant. (Defaults to \code{n)^2}.)} #' \item{layout.par$elen}{ Provides the matrix of interpoint distances to be approximated. (Defaults to the geodesic distances of \code{nw} after symmetrizing, capped at \code{sqrt(n)}.)} #' \item{layout.par$seed.coord}{ A two-column matrix of initial vertex coordinates. (Defaults to a gaussian layout.) } #' } #' } #' } #' #' @name network.layout #' #' @param nw a network object, as passed by \code{\link{plot.network}}. #' @param layout.par a list of parameters. #' @return A matrix whose rows contain the x,y coordinates of the vertices of #' \code{d}. #' @note The \code{network.layout} routines shown here are adapted directly #' from the \code{\link[sna]{gplot.layout}} routines of the \code{sna} package. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{plot.network}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' #' Fruchterman, T.M.J. and Reingold, E.M. (1991). \dQuote{Graph Drawing by #' Force-directed Placement.} \emph{Software - Practice and Experience,} #' 21(11):1129-1164. #' #' Kamada, T. and Kawai, S. (1989). \dQuote{An Algorithm for Drawing General #' Undirected Graphs.} \emph{Information Processing Letters,} 31(1):7-15. #' @keywords graphs dplot #' @export network.layout.circle<-function(nw,layout.par){ n<-network.size(nw) cbind(sin(2*pi*((0:(n-1))/n)),cos(2*pi*((0:(n-1))/n))) } #Fruchterman-Reingold layout routine for plot.network #' @rdname network.layout #' @export network.layout.fruchtermanreingold<-function(nw,layout.par){ #Provide default settings n<-network.size(nw) d<-as.matrix.network(nw,matrix.type="edgelist")[,1:2,drop=FALSE] if(is.null(layout.par$niter)) niter<-500 else niter<-layout.par$niter if(is.null(layout.par$max.delta)) max.delta<-n else max.delta<-layout.par$max.delta if(is.null(layout.par$area)) area<-n^2 else area<-layout.par$area if(is.null(layout.par$cool.exp)) cool.exp<-3 else cool.exp<-layout.par$cool.exp if(is.null(layout.par$repulse.rad)) repulse.rad<-area*log(n) else repulse.rad<-layout.par$repulse.rad if(is.null(layout.par$ncell)) ncell<-ceiling(n^0.4) else ncell<-layout.par$ncell if(is.null(layout.par$cell.jitter)) cell.jitter<-0.5 else cell.jitter<-layout.par$cell.jitter if(is.null(layout.par$cell.pointpointrad)) cell.pointpointrad<-0 else cell.pointpointrad<-layout.par$cell.pointpointrad if(is.null(layout.par$cell.pointcellrad)) cell.pointcellrad<-18 else cell.pointcellrad<-layout.par$cell.pointcellrad if(is.null(layout.par$cellcellcellrad)) cell.cellcellrad<-ncell^2 else cell.cellcellrad<-layout.par$cell.cellcellrad if(is.null(layout.par$seed.coord)){ tempa<-sample((0:(n-1))/n) #Set initial positions randomly on the circle x<-n/(2*pi)*sin(2*pi*tempa) y<-n/(2*pi)*cos(2*pi*tempa) }else{ x<-layout.par$seed.coord[,1] y<-layout.par$seed.coord[,2] } #Symmetrize the network, just in case d<-unique(rbind(d,d[,2:1])) #Perform the layout calculation layout<-.C("network_layout_fruchtermanreingold_R", as.double(d), as.double(n), as.double(NROW(d)), as.integer(niter), as.double(max.delta), as.double(area), as.double(cool.exp), as.double(repulse.rad), as.integer(ncell), as.double(cell.jitter), as.double(cell.pointpointrad), as.double(cell.pointcellrad), as.double(cell.cellcellrad), x=as.double(x), y=as.double(y), PACKAGE="network") #Return the result cbind(layout$x,layout$y) } #Kamada-Kawai layout function for plot.network #' @rdname network.layout #' @export network.layout.kamadakawai<-function(nw,layout.par){ n<-network.size(nw) d<-as.sociomatrix(nw) if(is.null(layout.par$niter)){ niter<-1000 }else niter<-layout.par$niter if(is.null(layout.par$sigma)){ sigma<-n/4 }else sigma<-layout.par$sigma if(is.null(layout.par$initemp)){ initemp<-10 }else initemp<-layout.par$initemp if(is.null(layout.par$coolexp)){ coolexp<-0.99 }else coolexp<-layout.par$coolexp if(is.null(layout.par$kkconst)){ kkconst<-n^2 }else kkconst<-layout.par$kkconst if(is.null(layout.par$elen)){ # these functions require that the SNA package be installed elen<-sna::geodist(sna::symmetrize(d),inf.replace=sqrt(n),count.paths = FALSE,predecessors = FALSE)$gdist }else elen<-layout.par$elen if(is.null(layout.par$seed.coord)){ x<-rnorm(n,0,n/4) y<-rnorm(n,0,n/4) }else{ x<-layout.par$seed.coord[,1] y<-layout.par$seed.coord[,2] } #Obtain locations pos<-.C("network_layout_kamadakawai_R",as.integer(d),as.double(n), as.integer(niter),as.double(elen),as.double(initemp),as.double(coolexp), as.double(kkconst),as.double(sigma),x=as.double(x),y=as.double(y), PACKAGE="network") #Return to x,y coords cbind(pos$x,pos$y) } network/R/misc.R0000644000176200001440000004607514060057170013236 0ustar liggesusers###################################################################### # # misc.R # # Written by Carter T. Butts ; portions contributed by # David Hunter and Mark S. Handcock # . # # Last Modified 06/08/21 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains various network routines which don't fit anywhere # else (generally, utilities and the like). # # Contents: # # is.discrete # is.discrete.character # is.discrete.numeric # which.matrix.type # ###################################################################### #' Transform vector of values into color specification #' #' Convenience function to convert a vector of values into a color #' specification. #' #' @param x vector of numeric, character or factor values to be transformed #' @param opacity optional numeric value in the range 0.0 to 1.0 used to specify #' the opacity/transparency (alpha) of the colors to be returned. 0 means #' fully opaque, 1 means fully transparent. #' #' Behavior of \code{as.color} is as follows: \itemize{ \item integer numeric #' values: unchanged, (assumed to corespond to values of R's active #' \code{\link{palette}}) \item integer real values: will be translated to into #' grayscale values ranging between the max and min \item factor: integer #' values corresponding to factor levels will be used \item character: if #' values are valid colors (as determined by \code{is.color}) they will be #' returned as is. Otherwise converted to factor and numeric value of factor #' returned. } #' #' The optional \code{opacity} parameter can be used to make colors partially #' transparent (as a shortcut for \code{\link{adjustcolor}}. If used, colors #' will be returned as hex rgb color string (i.e. \code{"#00FF0080"}) #' #' The \code{is.color} function checks if each character element of \code{x} #' appears to be a color name by comparing it to \code{\link{colors}} and #' checking if it is an HTML-style hex color code. Note that it will return #' FALSE for integer values. #' #' These functions are used for the color parameters of #' \code{\link{plot.network}}. #' #' @return For \code{as.color}, a vector integer values (corresponding to color #' palette values) or character color name. For \code{is.color}, a logical #' vector indicating if each element of x appears to be a color #' #' @rdname as.color #' @export #' #' @examples #' #' #' as.color(1:3) #' as.color(c('a','b','c')) #' #' # add some transparency #' as.color(c('red','green','blue'),0.5) # gives "#FF000080", "#00FF0080", "#0000FF80" #' #' is.color(c('red',1,'foo',NA,'#FFFFFF55')) as.color<-function(x,opacity=1.0){ if(opacity > 1 | opacity < 0){ stop('opacity parameter must be a numeric value in the range 0 to 1') } colors<-x #Numeric rule: if integer leave as-is, otherwise convert to grayscale if(is.numeric(x)){ if(any(x!=round(x),na.rm=TRUE)){ colors<-gray((x-min(x))/(max(x)-min(x))) }else colors<-x } #Factor rule: categorical colorings if(is.factor(x)){ colors<-match(levels(x)[x],levels(x)) } #Character rule: if colors, retain as colors; else categorical if(is.character(x)){ if(all(is.color(x))) colors<-x else{ colors<-match(x,sort(unique(x))) } } # add transparency if not 1 if(opacity < 1){ colors<-grDevices::adjustcolor(colors,alpha.f=opacity) } return(colors) } # Mixing matrix ----------------------------------------------------------- #' Mixing matrix #' #' Return the mixing matrix for a network, on a given attribute. #' #' @param object a network or some other data structure for which a mixing #' matrix is meaningful. #' @param ... further arguments passed to or used by methods. #' #' @rdname mixingmatrix #' @export mixingmatrix <- function(object, ...) UseMethod("mixingmatrix") # Return the mixing matrix for a network object, on a given attribute. This is # a relocated function from the ergm package; it probably belongs elsewhere, but # is needed for the summary.network method (and in that sense is basic enough to # include. #' @rdname mixingmatrix #' #' @param attrname a vertex attribute name. #' @param expand.bipartite logical; if `object` is bipartite, should we return #' the *square* mixing matrix representing every level of `attrname` against #' every other level, or a *rectangular* matrix considering only levels #' present in each bipartition? #' @param useNA one of "ifany", "no" or "always". Argument passed to #' \code{\link{table}}. By default (\code{useNA = "ifany"}) if there are any #' \code{NA}s on the attribute corresponding row \emph{and} column will be #' contained in the result. See Details. #' @param ... arguments passed to \code{\link{table}}. #' #' @details Handling of missing values on the attribute \code{attrname} almost #' follows similar logic to \code{\link{table}}. If there are \code{NA}s on #' the attribute and \code{useNA="ifany"} (default) the result will contain #' both row and column for the missing values to ensure the resulting matrix #' is square (essentially calling \code{\link{table}} with #' \code{useNA="always"}). Also for that reason passing \code{exclude} #' parameter with \code{NULL}, \code{NA} or \code{NaN} is ignored with a #' warning as it may break the symmetry. #' #' @return Function `mixingmatrix()` returns an object of class `mixingmatrix` #' extending `table` with a cross-tabulation of edges in the `object` #' according to the values of attribute `attrname` for the two incident #' vertices. If `object` is a *directed* network rows correspond to the "tie #' sender" and columns to the "tie receiver". If `object` is an *undirected* #' network there is no such distinction and the matrix is symmetrized. In both #' cases the matrix is square and all the observed values of the attribute #' `attrname` are represented in rows and columns. If `object` is a #' *bipartite* network and `expand.bipartite` is `FALSE` the resulting matrix #' does not have to be square as only the actually observed values of the #' attribute are shown for each partition, if `expand.bipartite` is `TRUE` the #' matrix will be square. #' #' @export #' @examples #' # Interaction ties between Lake Pomona SAR organizations by sponsorship type #' # of tie sender and receiver (data from Drabek et al. 1981) #' data(emon) #' mixingmatrix(emon$LakePomona, "Sponsorship") mixingmatrix.network <- function(object, attrname, useNA = "ifany", expand.bipartite=FALSE, ...) { nw <- object if(missing(attrname)){ stop("attrname argument is missing. mixingmatrix() requires an an attribute name") } if(!(attrname %in% list.vertex.attributes(object))) stop("vertex attribute ", sQuote(attrname), " not found in network ", sQuote(deparse(substitute(object)))) if(network.size(nw)==0L){ warning("mixing matrices not well-defined for graphs with no vertices.") return(as.mixingmatrix( matrix(nrow=0L, ncol=0L), directed = is.directed(object), bipartite = is.bipartite(object) )) } nodecov <- unlist(get.vertex.attribute(nw, attrname)) u<-sort(unique(nodecov)) # nodecovnum <- match(nodecov, u) el <- as.matrix.network.edgelist(nw) type <- "directed" if (is.bipartite(nw)) { # must have heads < tails now if (is.directed(nw)) cat("Warning: Bipartite networks are currently\n", "automatically treated as undirected\n") type <- "bipartite" rowswitch <- apply(el, 1L, function(x) x[1L]>x[2L]) el[rowswitch, 1L:2L] <- el[rowswitch, 2L:1L] nb1 <- get.network.attribute(nw,"bipartite") if(!expand.bipartite) u <- sort(unique(nodecov[1L:nb1])) From <- factor(nodecov[el[,1L]], levels=u) if(!expand.bipartite) u <- sort(unique(nodecov[(nb1+1L):network.size(nw)])) To <- factor(nodecov[el[,2L]], levels=u) }else{ From <- factor(nodecov[el[,1L]], levels=u) To <- factor(nodecov[el[,2L]], levels=u) } if(any(is.na(nodecov)) && useNA == "ifany") useNA <- "always" dots <- list(...) if("exclude" %in% names(dots) && (is.null(dots$exclude) | any(is.na(dots$exclude)) | any(is.nan(dots$exclude)))) { warning("passing `exclude=NULL` to table() is not supported, ignoring") dots$exclude <- NULL } tabu <- do.call(table, c(list(From=From, To=To, useNA=useNA), dots)) if(!is.directed(nw) && !is.bipartite(nw)){ type <- "undirected" tabu <- tabu + t(tabu) diag(tabu) <- diag(tabu)%/%2L } as.mixingmatrix( tabu, directed = is.directed(object), bipartite = is.bipartite(object) ) } #' @rdname mixingmatrix #' #' @note The `$` and `[[` methods are included only for backward-compatiblity #' reason and will become defunct in future releases of the package. #' #' @export "[[.mixingmatrix" <- function(x, ...) { .Deprecated( new = "mixingmatrix", msg = "Mixing matrix objects now extend class \"table\". The `[[` method is deprecated and will be removed from future releases of the package. See ?mixingmatrix for details." ) x <- .to_oldmm(x) NextMethod() } #' @rdname mixingmatrix #' #' @param name name of the element to extract, one of "matrix" or "type" #' #' @export "$.mixingmatrix" <- function(x, name) { .Deprecated( new = "mixingmatrix", msg = "Mixing matrix objects now extend class \"table\". The `$` method is deprecated and will be removed from future releases of the package. See ?mixingmatrix for details." ) x <- .to_oldmm(x) NextMethod() } .to_oldmm <- function(x) { directed <- attr(x, "directed") bipartite <- attr(x, "bipartite") list( matrix = structure(as.integer(x), dimnames=dimnames(x), dim=dim(x)), type = if(bipartite) "bipartite" else if(directed) "directed" else "undirected" ) } # A non-exported constructor of mixingmatrix objects # # @param mat matrix with the actual cross-tabulation # @param directed logical if the network is directed # @param bipartite logical if the netwoek is bipartite # @param ... other arguments currently ignored # # @return The matrix with attributes `directed` and `bipartite` of class # `mixingmatrix` inheriting from `table`. as.mixingmatrix <- function(mat, directed, bipartite, ...) { # Test/check/symmetrize here? structure( mat, directed = directed, bipartite = bipartite, class = c("mixingmatrix", "table") ) } #' @rdname mixingmatrix #' #' @return Functions `is.directed()` and `is.bipartite()` return `TRUE` or #' `FALSE`. The values will be identical for the input network `object`. #' #' @export is.directed.mixingmatrix <- function(x, ...) attr(x, "directed") #' @rdname mixingmatrix #' @export is.bipartite.mixingmatrix <- function(x, ...) attr(x, "bipartite") #' @rdname mixingmatrix #' #' @param x mixingmatrix object #' #' @export print.mixingmatrix <- function(x, ...) { m <- x rn <- rownames(x) cn <- colnames(x) if (!attr(x, "directed")) { dimnames(m) <- list(rn, cn) on.exit( message("Note: Marginal totals can be misleading for undirected mixing matrices.") ) } else { dimnames(m) <- if(attr(x, "bipartite")) list(B1 = rn, B2 = cn) else list(From = rn, To = cn) m <- stats::addmargins(m) } m <- structure( m, directed = attr(x, "directed"), bipartite = attr(x, "bipartite"), class = "table" ) print(m) } # network.density --------------------------------------------------------- #' Compute the Density of a Network #' #' \code{network.density} computes the density of its argument. #' #' The density of a network is defined as the ratio of extant edges to #' potential edges. We do not currently consider edge values; missing edges are #' omitted from extent (but not potential) edge count when #' \code{na.omit==TRUE}. #' #' @param x an object of class \code{network} #' @param na.omit logical; omit missing edges from extant edges when assessing #' density? #' @param discount.bipartite logical; if \code{x} is bipartite, should #' \dQuote{forbidden} edges be excluded from the count of potential edges? #' @return The network density. #' @section Warning : \code{network.density} relies on network attributes (see #' \link{network.indicators}) to determine the properties of the underlying #' network object. If these are set incorrectly (e.g., multiple edges in a #' non-multiplex network, network coded with directed edges but set to #' \dQuote{undirected}, etc.), surprising results may ensue. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network.edgecount}}, \code{\link{network.size}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' #' Wasserman, S. and Faust, K. (1994). \emph{Social Network Analysis: Methods #' and Applications.} Cambridge: Cambridge University Press. #' @keywords graphs #' @examples #' #' #Create an arbitrary adjacency matrix #' m<-matrix(rbinom(25,1,0.5),5,5) #' diag(m)<-0 #' #' g<-network.initialize(5) #Initialize the network #' network.density(g) #Calculate the density #' #' @rdname network.density #' @export network.density network.density<-function(x,na.omit=TRUE,discount.bipartite=FALSE){ if(!is.network(x)) stop("network.density requires a network object.") if(network.size(x)==0){ warning("Density is not well-defined for networks of order 0.") return(NaN) } if(is.multiplex(x)) warning("Network is multiplex - no general way to define density. Returning value for a non-multiplex network (hope that's what you wanted).\n") ec<-network.edgecount(x,na.omit=na.omit) n<-network.size(x) bip<-x%n%"bipartite" if(is.hyper(x)){ if((bip>=0)&&(discount.bipartite)){ pe<-choose(bip,1:bip)*choose(n-bip,1:(n-bip))*(1+is.directed(x)) }else{ if(has.loops(x)) pe<-sum(choose(n,1:n))^(1+is.directed(x)) else pe<-sum(choose(n,1:n))/(1+!is.directed(x)) } }else{ if((bip>=0)&&(discount.bipartite)){ pe<-bip*(n-bip)*(1+is.directed(x)) }else{ pe<-n*(n-1)/(1+!is.directed(x))+(has.loops(x)*network.size(x)) } } ec/pe } # has.edges --------------------------------------------------------------- #' Determine if specified vertices of a network have any edges (are not #' isolates) #' #' Returns a logical value for each specified vertex, indicating if it has any #' incident (in or out) edges. Checks all vertices by default #' #' #' @aliases is.isolate #' @param net a \code{\link{network}} object to be queried #' @param v integer vector of vertex ids to check #' @return returns a logical vector with the same length as v, with TRUE if the #' vertex is involved in any edges, FALSE if it is an isolate. #' @author skyebend #' @examples #' #' test<-network.initialize(5) #' test[1,2]<-1 #' has.edges(test) #' has.edges(test,v=5) #' #' @rdname has.edges #' @export has.edges has.edges<-function(net,v=seq_len(network.size(net))){ if(network.size(net)==0){ return(logical(0)) } if(any(v < 1) | any(v > network.size(net))){ stop("'v' argument must be a valid vertex id in is.isolate") } ins<-sapply(net$iel[v],length) outs<-sapply(net$oel[v],length) return(ins+outs != 0) } # is.color ---------------------------------------------------------------- #' @rdname as.color #' #' @return \code{as.color()} returns TRUE if x is a character in a known color format. #' #' @export is.color<-function(x){ xic<-rep(FALSE,length(x)) #Assume not a color by default xc<-sapply(x,is.character) #Must be a character string #For characters, must be a named color or a #RRGGBB/#RRGGBBAA sequence xic[xc]<-(x[xc]%in%colors())| ((nchar(x[xc])%in%c(7,9))&(substr(x[xc],1,1)=="#")) xic[is.na(x)]<-NA #Missing counts as missing #Return the result xic } #' Internal Network Package Functions #' #' Internal network functions. #' #' Most of these are not to be called by the user. #' #' @name network-internal #' #' @param x an object to be designated either discrete or continuous, or a #' network. #' @param y a network or something coercible to one. #' @param \dots further arguments passed to or used by methods. #' #' @seealso network #' #' @keywords internal #' @rdname network-internal #' @export is.discrete.numeric<-function(x){ (is.numeric(x)|is.logical(x)) && mean(duplicated(x)) > 0.8 } #' @rdname network-internal #' @export is.discrete.character<-function(x){ (is.character(x)|is.logical(x)) && mean(duplicated(x)) > 0.8 } #' @rdname network-internal #' @export is.discrete<-function(x){ (is.numeric(x)|is.logical(x)|is.character(x)) && mean(duplicated(x)) > 0.8 } # which.matrix.type ------------------------------------------------------- #' Heuristic Determination of Matrix Types for Network Storage #' #' \code{which.matrix.type} attempts to choose an appropriate matrix expression #' for a \code{network} object, or (if its argument is a matrix) attempts to #' determine whether the matrix is of type adjacency, incidence, or edgelist. #' #' The heuristics used to determine matrix types are fairly arbitrary, and #' should be avoided where possible. This function is intended to provide a #' modestly intelligent fallback option when explicit identification by the #' user is not possible. #' #' @param x a matrix, or an object of class \code{network} #' @return One of \code{"adjacency"}, \code{"incidence"}, or \code{"edgelist"} #' @author David Hunter \email{dhunter@@stat.psu.edu} #' @seealso \code{\link{as.matrix.network}}, \code{\link{as.network.matrix}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @keywords graphs #' @examples #' #' #Create an arbitrary adjacency matrix #' m<-matrix(rbinom(25,1,0.5),5,5) #' diag(m)<-0 #' #' #Can we guess the type? #' which.matrix.type(m) #' #' #Try the same thing with a network #' g<-network(m) #' which.matrix.type(g) #' which.matrix.type(as.matrix.network(g,matrix.type="incidence")) #' which.matrix.type(as.matrix.network(g,matrix.type="edgelist")) #' #' @rdname which.matrix.type #' @export which.matrix.type which.matrix.type<-function(x) { if (!is.network(x)) { if (is.character(x<-as.matrix(x))){ if (diff(dim(x))==0) out<-"adjacency" else if (dim(x)[2]==2) out<-"edgelist" else out<-"bipartite" }else if (!is.numeric(x)) out<-NA else if (diff(dim(x))==0) out<-"adjacency" else if (NROW(x)==0) #For a 0-row matrix, an empty edgelist is the best bet... out<-"edgelist" else if (max(abs(x),na.rm=TRUE)==1 && max(abs(x-as.integer(x)),na.rm=TRUE)==0) out<-"bipartite" else if (max(abs(x-as.integer(x))[,1:2],na.rm=TRUE)==0 && min(x[,1:2],na.rm=TRUE)>0) out<-"edgelist" else out<-NA } else { # Very ad-hoc criteria for choosing; choice can be overridden. if (is.hyper(x)) out<-"incidence" else if ((n<-x$gal$n)<14 || x$gal$mnext>n*n/2) out<-"adjacency" else out<-"edgelist" } out } network/R/coercion.R0000644000176200001440000006420614060056545014105 0ustar liggesusers###################################################################### # # coercion.R # # Written by Carter T. Butts ; portions contributed by # David Hunter and Mark S. Handcock # . # # Last Modified 06/08/21 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains various routines for coercion to/from network # class objects. # # Contents: # # as.matrix.network # as.matrix.network.adjacency # as.matrix.network.edgelist # as.matrix.network.incidence # as.network # as.network.default # as.network.network # as.network.matrix # as.sociomatrix # ###################################################################### # Method for general coercion of network class objects into matrices. # Matrix type is indicated by the eponymous argument; note that some # types may not be supported for certain networks. Where # attrname!=NULL, an edge attribute of name attrname is used to supply # edge values. Otherwise, edges are assumed to be unvalued. # #' Coerce a Network Object to Matrix or Table Form #' #' The \code{as.matrix} methods attempt to coerce their input to a matrix in #' adjacency, incidence, or edgelist form. Edge values (from a stored #' attribute) may be used if present. \code{\link[tibble:as_tibble]{as_tibble}} #' coerces into an edgelist in \code{\link{tibble}} (a type of #' \code{\link{data.frame}}) form; this can be especially useful if extrecting #' a character-type edge attribute. #' #' If no matrix type is specified, \code{\link{which.matrix.type}} will be used #' to make an educated guess based on the shape of \code{x}. Where edge values #' are not specified, a dichotomous matrix will be assumed. #' #' Edgelists returned by the \code{as.matrix} methods are by default in a #' slightly different form from the \code{sna} edgelist standard, but do #' contain the \code{sna} extended matrix attributes (see #' \code{\link{as.network.matrix}}). They should typically be compatible with #' \code{sna} library functions. To ensure compatibility, the #' \code{as.sna.edgelist} argument can be set (which returns an exact #' \code{sna} edgelist). The \code{\link{as.edgelist}} function also returns a #' similar edgelist matrix but with an enforced sorting. #' #' For the \code{as.matrix} methods, if the \code{attrname} attribute is used #' to include a charcter attribute, the resulting edgelist matrix will be #' character rather than numeric. The \code{as_tibble} methods never coerce. #' #' Note that adjacency matrices may also be obtained using the extraction #' operator. See the relevant man page for details. Also note that which #' attributes get returned by the \code{as_tibble} method by default depends on #' \code{unit}: by default no edge attributes are returned but all vertex #' attributes are. #' #' @param x an object of class \code{network} #' @param matrix.type one of \code{"adjacency"}, \code{"incidence"}, #' \code{"edgelist"}, or \code{NULL} #' @param attrname optionally, the name of an edge attribute to use for edge #' values #' @param attrnames optionally, either a character vector of the names of edge #' attributes to use for edge values, or a numerical or logical vector to use #' as indices for selecting them from \code{\link{list.edge.attributes}(x)} or #' \code{\link{list.vertex.attributes}(x)} (depending on \code{unit}); passing #' \code{TRUE} therefore returns all edge attributes as columns #' @param expand.bipartite logical; if \code{x} is bipartite, should we return #' the full adjacency matrix (rather than the abbreviated, two-mode form)? #' @param as.sna.edgelist logical; should the edgelist be returned in sna #' edglist form? #' @param na.rm logical; should missing edges/vertices be included in the #' edgelist formats? Ignored if \code{as.sna.edgelist=TRUE}. #' @param unit whether a \code{\link{tibble}} of edge or vertex attributes #' should be returned. #' @param ... additional arguments. #' @return For \code{as.matrix} methods, an adjacency, incidence, or edgelist #' matrix. For the \code{as_tibble} method, a \code{tibble} whose first two #' columns are \code{.head} and \code{.tail}, whose third column \code{.eid} is #' the edge ID, and whose subsequent columns are the requested edge attributes. #' @author Carter T. Butts \email{buttsc@@uci.edu} and David Hunter #' \email{dhunter@@stat.psu.edu} #' @seealso \code{\link{which.matrix.type}}, \code{\link{network}}, #' \code{\link{network.extraction}},\code{\link{as.edgelist}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @keywords classes graphs #' @examples #' #' # Create a random network #' m <- matrix(rbinom(25,4,0.159),5,5) # 50% density #' diag(m) <- 0 #' g <- network(m, ignore.eval=FALSE, names.eval="a") # With values #' g %e% "ac" <- letters[g %e% "a"] #' #' # Coerce to matrix form #' # No attributes: #' as.matrix(g,matrix.type="adjacency") #' as.matrix(g,matrix.type="incidence") #' as.matrix(g,matrix.type="edgelist") #' # Attributes: #' as.matrix(g,matrix.type="adjacency",attrname="a") #' as.matrix(g,matrix.type="incidence",attrname="a") #' as.matrix(g,matrix.type="edgelist",attrname="a") #' as.matrix(g,matrix.type="edgelist",attrname="ac") #' #' # Coerce to a tibble: #' library(tibble) #' as_tibble(g) #' as_tibble(g, attrnames=c("a","ac")) #' as_tibble(g, attrnames=TRUE) #' # Get vertex attributes instead: #' as_tibble(g, unit = "vertices") #' #' # Missing data handling: #' g[1,2] <- NA #' as.matrix(g,matrix.type="adjacency") # NA in the corresponding cell #' as.matrix(g,matrix.type="edgelist", na.rm=TRUE) # (1,2) excluded #' as.matrix(g,matrix.type="edgelist", na.rm=FALSE) # (1,2) included #' as_tibble(g, attrnames="na", na.rm=FALSE) # Which edges are marked missing? #' #' # Can also use the extraction operator #' g[,] # Get entire adjacency matrix #' g[1:2,3:5] # Obtain a submatrix #' #' @export as.matrix.network #' @export as.matrix.network<-function(x,matrix.type=NULL,attrname=NULL,...){ #Get the matrix type if(is.null(matrix.type)) matrix.type<-"adjacency" else matrix.type<-match.arg(matrix.type,c("adjacency","incidence","edgelist")) #Dispatch as needed switch(matrix.type, adjacency=as.matrix.network.adjacency(x=x,attrname=attrname,...), incidence=as.matrix.network.incidence(x=x,attrname=attrname,...), edgelist=as.matrix.network.edgelist(x=x,attrname=attrname,...) ) } # Coerce a network object to an adjacency matrix (where possible). If # provided, attrname is used to identify an attribute to use for edge # values. # #' @rdname as.matrix.network #' @usage \method{as.matrix.network}{adjacency}(x, attrname=NULL, #' expand.bipartite = FALSE, ...) #' @export as.matrix.network.adjacency #' @rawNamespace S3method(as.matrix.network,adjacency) as.matrix.network.adjacency<-function(x,attrname=NULL,expand.bipartite=FALSE,...){ #Check to make sure this is a supported network type if(is.hyper(x)) stop("Hypergraphs not currently supported in as.matrix.network.adjacency. Exiting.\n") if(is.multiplex(x)) stop("Multigraphs not currently supported in as.matrix.network.adjacency. Exiting.\n") #Generate the adjacency matrix m<-matrix(0,nrow=network.size(x),ncol=network.size(x)) if(network.size(x)==0) return(m) tl<-unlist(sapply(x$mel,"[[","outl")) #Can unlist b/c no hyperedges hl<-unlist(sapply(x$mel,"[[","inl")) nal<-as.logical(get.edge.attribute(x$mel,"na",unlist=TRUE)) if(!is.null(attrname)){ val<-unlist(get.edge.attribute(x$mel,attrname,unlist=FALSE)) if(is.null(val)){ warning(paste("There is no edge attribute named", attrname)) val<-rep(1,length(tl)) } }else{ val<-rep(1,length(tl)) } if(length(hl[!nal])>0){ m[tl[!nal]+(hl[!nal]-1)*network.size(x)]<-val[!nal] } if(length(hl[ nal])>0){ m[tl[ nal]+(hl[ nal]-1)*network.size(x)]<-NA } #If undirected, symmetrize if(!is.directed(x)){ # changed by MSH to allow non binary values # m<-pmax(m,t(m)) sel<-m sel[is.na(m)]<-1 m[sel==0] <- t(m)[sel==0] } #Set row/colnames to vertex names xnames <- network.vertex.names(x) dimnames(m) <- list(xnames, xnames) #If bipartite and !expand.bipartite, return in two-mode form if(is.bipartite(x)&(!expand.bipartite)){ nactors <- get.network.attribute(x, "bipartite") nevents <- network.size(x) - nactors m <- m[0:nactors, nactors+(1:nevents)] } #Return the result m } # Coerce a network object to an edgelist matrix. If provided, attrname is # used to identify an attribute to use for edge values. Setting as.sna.edgelist # results in output in the sna edgelist format (including missing edge handling) # and is used by the sna package for coercion. # #' @rdname as.matrix.network #' @usage \method{as.matrix.network}{edgelist}(x, attrname=NULL, #' as.sna.edgelist = FALSE, na.rm = TRUE, ...) #' @export as.matrix.network.edgelist #' @rawNamespace S3method(as.matrix.network,edgelist) as.matrix.network.edgelist<-function(x,attrname=NULL,as.sna.edgelist=FALSE,na.rm=TRUE,...){ #Check to make sure this is a supported network type if(is.hyper(x)) stop("Hypergraphs not currently supported in as.matrix.network.edgelist. Exiting.\n") #Find the missing edges nal<-as.logical(get.edge.attribute(x$mel,"na")) #Generate the edgelist matrix m<-cbind(unlist(sapply(x$mel,"[[","outl")), unlist(sapply(x$mel,"[[","inl"))) #Add edge values, if needed if(!is.null(attrname)) m<-cbind(m,get.edge.attribute(x$mel,attrname,na.omit=FALSE,null.na=TRUE,deleted.edges.omit=TRUE)) else if(as.sna.edgelist) m<-cbind(m,rep(1,NROW(m))) #Set additional attributes and return the result if(as.sna.edgelist && nrow(m) > 0) # check that there are actually edges m[nal,3]<-NA else if(na.rm) m<-m[!nal,,drop=FALSE] if(length(m)==0) m<-matrix(numeric(0),ncol=2+as.sna.edgelist+!is.null(attrname)) else if((!is.directed(x))&&as.sna.edgelist){ #sna uses directed form m<-rbind(m,m[m[,2]!=m[,1],c(2:1,3)]) } attr(m,"n")<-network.size(x) attr(m,"vnames")<-network.vertex.names(x) if(is.bipartite(x)) attr(m,"bipartite")<-x%n%"bipartite" m } # Coerce a network object to an edgelist tibble. If provided, attrnames is # used to identify a list of attributes to use for edge values. # #' @rdname as.matrix.network #' @param store.eid whether the edge ID should be stored in the third column (`.eid`). #' @importFrom statnet.common simplify_simple #' @export as_tibble.network<-function(x,attrnames=(match.arg(unit)=="vertices"),na.rm=TRUE,..., unit=c("edges", "vertices"), store.eid=FALSE){ unit <- match.arg(unit) if(unit=="edges"){ #Find the missing edges nal<-as.logical(get.edge.attribute(x$mel,"na")) #Generate the edgelist matrix tails <- lapply(x$mel,`[[`,"outl") heads <- lapply(x$mel,`[[`,"inl") m <- list( .tail = if(is.hyper(x)) tails else as.integer(unlist(tails)), .head = if(is.hyper(x)) heads else as.integer(unlist(heads)) ) if(store.eid) m$.eid <- which(as.logical(sapply(tails, length)) | as.logical(sapply(heads, length))) #Add edge values, if needed # If logical or numeric, use as index; na.omit() is needed to handle # a pathological case where list.edge.attributes(x) is empty but # attrnames=TRUE. if(is.logical(attrnames) || is.numeric(attrnames)) attrnames <- na.omit(list.edge.attributes(x)[attrnames]) a <- attrnames %>% lapply(get.edge.attribute, x=x$mel, unlist=FALSE, na.omit=FALSE,null.na=TRUE,deleted.edges.omit=TRUE) %>% # Obtain a list of edge attribute values. lapply(simplify_simple, toNA="keep") %>% set_names(attrnames) m <- c(m, a) }else{ # "vertices" is the only other possibility at this time #Find the missing vertices nal<-as.logical(get.vertex.attribute(x,"na")) if(is.logical(attrnames) || is.numeric(attrnames)) attrnames <- na.omit(list.vertex.attributes(x)[attrnames]) a <- attrnames %>% lapply(get.vertex.attribute, x=x, unlist=FALSE, na.omit=FALSE,null.na=TRUE) %>% # Obtain a list of edge attribute values. lapply(simplify_simple, toNA="keep") %>% set_names(attrnames) m <- a } m <- as_tibble(m) if(na.rm) m <- m[!nal,] attr(m,"n")<-network.size(x) attr(m,"vnames")<-network.vertex.names(x) if(is.bipartite(x)) attr(m,"bipartite")<-x%n%"bipartite" m } #' @rdname as.matrix.network #' @rawNamespace S3method(as.tibble,network) as.tibble.network <- as_tibble.network # Coerce a network object to an incidence matrix (where possible). If # provided, attrname is used to identify an attribute to use for edge # values. # #' @rdname as.matrix.network #' @usage \method{as.matrix.network}{incidence}(x, attrname=NULL, ...) #' @export as.matrix.network.incidence #' @rawNamespace S3method(as.matrix.network,incidence) as.matrix.network.incidence<-function(x,attrname=NULL,...){ #Perform preprocessing n<-network.size(x) nulledge<-sapply(x$mel,is.null) inl<-lapply(x$mel,"[[","inl")[!nulledge] outl<-lapply(x$mel,"[[","outl")[!nulledge] if(!is.null(attrname)) evals<-unlist(get.edge.attribute(x$mel,attrname))[!nulledge] else evals<-rep(1,length(x$mel))[!nulledge] ena<-as.logical(get.edge.attribute(x$mel,"na"))[!nulledge] #If called with an empty graph, return a degenerate matrix if(length(ena)==0) return(matrix(numeric(0),nrow=n)) #Generate the incidence matrix dir<-is.directed(x) f<-function(a,m,k){y<-rep(0,m); y[a]<-k; y} im<-sapply(inl,f,n,1)+sapply(outl,f,n,ifelse(dir,-1,1)) if(!dir) im<-pmin(im,1) im<-sweep(im,2,evals,"*") #Fill in edge values im[(sapply(ena,rep,n)*(im!=0))>0]<-NA #Add NAs, if needed #Return the result im } #' @rdname network #' @export as.network<-function(x,...) UseMethod("as.network") #' @name as.network.matrix #' #' @title Coercion from Matrices to Network Objects #' #' @description \code{as.network.matrix} attempts to coerce its first argument to an object #' of class \code{network}. #' #' @details Depending on \code{matrix.type}, one of three edgeset constructor methods #' will be employed to read the input matrix (see #' \code{\link{edgeset.constructors}}). If \code{matrix.type==NULL}, #' \code{\link{which.matrix.type}} will be used to guess the appropriate matrix #' type. #' #' The coercion methods will recognize and attempt to utilize the \code{sna} #' extended matrix attributes where feasible. These are as follows: \itemize{ #' \item\code{"n"}: taken to indicate number of vertices in the network. #' \item\code{"bipartite"}: taken to indicate the network's \code{bipartite} #' attribute, where present. \item\code{"vnames"}: taken to contain vertex #' names, where present. } These attributes are generally used with edgelists, #' and indeed data in \code{sna} edgelist format should be transparently #' converted in most cases. Where the extended matrix attributes are in #' conflict with the actual contents of \code{x}, results are no guaranteed #' (but the latter will usually override the former). For an edge list, the #' number of nodes in a network is determined by the number of unique nodes #' specified. If there are isolate nodes not in the edge list, the "n" #' attribute needs to be set. See example below. #' #' @param x a matrix containing an adjacency structure #' @param matrix.type one of \code{"adjacency"}, \code{"edgelist"}, #' \code{"incidence"}, or \code{NULL} #' @param directed logical; should edges be interpreted as directed? #' @param hyper logical; are hyperedges allowed? #' @param loops logical; should loops be allowed? #' @param multiple logical; are multiplex edges allowed? #' @param bipartite count; should the network be interpreted as bipartite? If #' present (i.e., non-NULL) it is the count of the number of actors in the #' bipartite network. In this case, the number of nodes is equal to the number #' of actors plus the number of events (with all actors preceding all events). #' The edges are then interpreted as nondirected. #' @param ignore.eval logical; ignore edge values? #' @param names.eval optionally, the name of the attribute in which edge values #' should be stored #' @param na.rm logical; ignore missing entries when constructing the network? #' @param edge.check logical; perform consistency checks on new edges? #' @param ... additional arguments #' @return An object of class \code{network} #' @author Carter T. Butts \email{buttsc@@uci.edu} and David Hunter #' \email{dhunter@@stat.psu.edu} #' @seealso \code{\link{edgeset.constructors}}, \code{\link{network}}, #' \code{\link{which.matrix.type}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @keywords classes graphs #' @examples #' #' #Draw a random matrix #' m<-matrix(rbinom(25,1,0.5),5) #' diag(m)<-0 #' #' #Coerce to network form #' g<-as.network.matrix(m,matrix.type="adjacency") #' #' # edge list example. Only 4 nodes in the edge list. #' m = matrix(c(1,2, 2,3, 3,4), byrow = TRUE, nrow=3) #' attr(m, 'n') = 7 #' as.network(m, matrix.type='edgelist') #' #' @export as.network.default #' @export as.network.default<-function(x,...) as.network.matrix(x,...) #' @export as.network.network #' @export as.network.network<-function(x,...) x # # MSH modified for bipartite # #' @rdname as.network.matrix #' @export as.network.matrix #' @export as.network.matrix<-function(x, matrix.type=NULL, directed=TRUE, hyper=FALSE, loops=FALSE, multiple=FALSE, bipartite=FALSE, ignore.eval=TRUE, names.eval=NULL, na.rm=FALSE, edge.check=FALSE, ...){ #Before doing anything else, pull any attributes from the matrix that we #might need.... nattr<-attr(x,"n") #Currently, only using sna edgelist attributes battr<-attr(x,"bipartite") vattr<-attr(x,"vnames") #Convert logicals to numeric form if(is.logical(x)){x <- 1*x} #Get the matrix type if(is.null(matrix.type)) matrix.type<-which.matrix.type(x) else matrix.type<-match.arg(matrix.type,c("adjacency","incidence","edgelist", "bipartite")) if(is.logical(bipartite)&&bipartite) matrix.type<-"bipartite" #Patch adj->bipartite case if((bipartite>0)&&(matrix.type=="adjacency")&&(NROW(x)==bipartite)) matrix.type<-"bipartite" # Add names if available unames <- NULL if(matrix.type=="edgelist"){ if(dim(x)[2]>2) vals<-x[,-(1:2),drop=FALSE] else vals<-NULL if(is.character(x<-as.matrix(x[,1:2,drop=FALSE]))){ unames <- sort(unique(as.vector(x))) x <- cbind(match(x[,1],unames),match(x[,2],unames)) } if(!is.null(vals)){ x<-cbind(x,vals) if (is.null(colnames(vals))){ colnames(x)<-NULL #R creates these, and they are annoying later } else { # leave colnames for vals intact so they can be used for edge attributes colnames(x)<-c(NA,NA,colnames(vals)) } } } if(matrix.type=="adjacency" && !is.null(colnames(x))){ unames <- colnames(x) } if(matrix.type=="bipartite"){ directed <- FALSE bipartite <- dim(x)[1] unames <- 1:sum(dim(x)) if(!is.null(rownames(x))){ unames[1:(dim(x)[1])] <- rownames(x) } if(!is.null(colnames(x))){ unames[(dim(x)[1])+(1:(dim(x)[2]))] <- colnames(x) } } if(!is.null(vattr)) #If given names, use 'em unames<-vattr #Initialize the network object if(is.numeric(nattr)){ #If given n, use it n<-nattr }else{ if((matrix.type=="edgelist")&&(NROW(x)==0)) stop("Cannot determine network size from zero-length edgelist; assign an n attribute to use data of this type.\n") n<-switch(matrix.type, #Extract n based on matrix type adjacency=dim(x)[1], incidence=dim(x)[1], bipartite=sum(dim(x)), edgelist=max(x[,1:2]), ) } if(is.numeric(battr)) #If given bipartite info, use it bipartite<-battr # if we are going to build an adjacency matrix and it doesn't match the nattr, give an error, because otherwise will crash # this may happen if a square edgelist with attribute information is passed in if (is.numeric(nattr) & matrix.type=='adjacency'){ if (nattr != ncol(x)){ stop('the dimensions of the matrix argument (',nrow(x),' by ', ncol(x),') do not match the network size indicated by the attached n attribute (',nattr,'), perhaps matrix.type argument is not correct') } } g<-network.initialize(n,directed=directed, hyper=hyper, loops=loops, multiple=multiple,bipartite=bipartite) #Call the specific coercion routine, depending on matrix type g<-switch(matrix.type, adjacency=network.adjacency(x,g, ignore.eval,names.eval,na.rm,edge.check), incidence=network.incidence(x,g, ignore.eval,names.eval,na.rm,edge.check), bipartite=network.bipartite(x,g, ignore.eval,names.eval,na.rm,edge.check), edgelist=network.edgelist(x,g, ignore.eval,names.eval,na.rm,edge.check) ) if(!is.null(unames)){ g <- set.vertex.attribute(g,"vertex.names", unames) } #Return the result g } #Force the input into sociomatrix form. This is a shortcut to #as.matrix.network.adjacency, which ensures that a raw matrix is #passed through as-is. #' Coerce One or More Networks to Sociomatrix Form #' #' \code{as.sociomatrix} takes adjacency matrices, adjacency arrays, #' \code{\link{network}} objects, or lists thereof, and returns one or more #' sociomatrices (adjacency matrices) as appropriate. This routine provides a #' useful input-agnostic front-end to functions which process adjacency #' matrices. #' #' \code{as.sociomatrix} provides a more general means of coercing input into #' adjacency matrix form than \code{\link{as.matrix.network}}. In particular, #' \code{as.sociomatrix} will attempt to coerce all input networks into the #' appropriate form, and return the resulting matrices in a regularized manner. #' If \code{simplify==TRUE}, \code{as.sociomatrix} attempts to return the #' matrices as a single adjacency array. If the input networks are of variable #' size, or if \code{simplify==FALSE}, the networks in question are returned as #' a list of matrices. In any event, a single input network is always returned #' as a lone matrix. #' #' If \code{attrname} is given, the specified edge attribute is used to extract #' edge values from any \code{\link{network}} objects contained in \code{x}. #' Note that the same attribute will be used for all networks; if no attribute #' is specified, the standard dichotomous default will be used instead. #' #' @param x an adjacency matrix, array, \code{\link{network}} object, or list #' thereof. #' @param attrname optionally, the name of a network attribute to use for #' extracting edge values (if \code{x} is a \code{\link{network}} object). #' @param simplify logical; should \code{as.sociomatrix} attempt to combine its #' inputs into an adjacency array (\code{TRUE}), or return them as separate #' list elements (\code{FALSE})? #' @param expand.bipartite logical; if \code{x} is bipartite, should we return #' the full adjacency matrix (rather than the abbreviated, two-mode form)? #' @param ... additional arguments for the coercion routine. #' @return One or more adjacency matrices. If all matrices are of the same #' dimension and \code{simplify==TRUE}, the matrices are joined into a single #' array; otherwise, the return value is a list of single adjacency matrices. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{as.matrix.network}}, \code{\link{network}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @keywords graphs manip #' @examples #' #' #Generate an adjacency array #' g<-array(rbinom(100,1,0.5),dim=c(4,5,5)) #' #' #Generate a network object #' net<-network(matrix(rbinom(36,1,0.5),6,6)) #' #' #Coerce to adjacency matrix form using as.sociomatrix #' as.sociomatrix(g,simplify=TRUE) #Returns as-is #' as.sociomatrix(g,simplify=FALSE) #Returns as list #' as.sociomatrix(net) #Coerces to matrix #' as.sociomatrix(list(net,g)) #Returns as list of matrices #' #' @export as.sociomatrix as.sociomatrix<-function(x, attrname=NULL, simplify=TRUE, expand.bipartite=FALSE, ...){ if(is.network(x)){ #If network, coerce to adjacency matrix g<-as.matrix.network.adjacency(x,attrname=attrname, expand.bipartite=expand.bipartite,...) }else if(is.matrix(x)||is.array(x)){ #If an array/matrix, use as-is g<-x }else if(is.list(x)){ #If a list, recurse on list elements g<-lapply(x,as.sociomatrix,attrname=attrname,simplify=simplify, expand.bipartite=expand.bipartite,...) }else{ stop("as.sociomatrix input must be an adjacency matrix/array, network, or list.") } #Convert into the appropriate return format if(is.list(g)){ #Collapse if needed if(length(g)==1){ g<-g[[1]] if((!simplify)&&(length(dim(g))==3)){ #Coerce to a list of matrices? out<-list() for(i in 1:dim(g)[1]) out[[i]]<-g[i,,] }else{ out<-g } }else{ #Coerce to array form? if(simplify){ dims<-sapply(g,dim) if(is.list(dims)){ #Dims must not be of equal length mats<-sapply(dims,length) mats[mats==1]<-0 mats[mats==2]<-1 mats[mats==3]<-sapply(dims[mats==3],"[[",1) mats<-cumsum(mats) dims<-sapply(dims,"[",2) }else{ #Dims are of equal length if(NROW(dims)==3) #Determine number of matrices per entry mats<-cumsum(dims[1,]) else mats<-1:NCOL(dims) dims<-dims[2,] #Get ncols } if((!any(is.null(dims)))&&(length(unique(dims))==1)&&(all(mats>0))){ out<-array(dim=c(mats[length(mats)],dims[1],dims[1])) for(i in 1:length(mats)) out[(c(0,mats)[i]+1):(mats[i]),,]<-g[[i]] }else out<-g }else out<-g } }else{ if((!simplify)&&(length(dim(g))==3)){ #Coerce to a list of matrices? out<-list() for(i in 1:dim(g)[1]) out[[i]]<-g[i,,] }else out<-g } #Return the result out } network/R/as.edgelist.R0000644000176200001440000001434613650471474014514 0ustar liggesusers# File R/edgelist.R in package network, part of the Statnet suite # of packages for network analysis, http://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 # http://statnet.org/attribution # # Copyright 2003-2015 Statnet Commons ####################################################################### # the edgelist functions have been copied in from ergm #' @export as.edgelist <- function(x, ...){ UseMethod("as.edgelist") } # convert a network into an ergm-style sorted edgelist using # as.edgelist.matrix and as.matrix.network.edgelist #' @name as.edgelist #' #' @title Convert a network object into a numeric edgelist matrix #' #' @description Constructs an edgelist in a sorted format with defined attributes. #' #' @details Constructs a edgelist matrix or tibble from a network, sorted tails-major #' order, with tails first, and, for undirected networks, tail < head. This #' format is required by some reverse-depending packages (e.g. \code{ergm}) #' #' The \code{\link{as.matrix.network.edgelist}} provides similar functionality #' but it does not enforce ordering or set the \code{edgelist} class and so #' should be slightly faster. #' #' \code{is.edgelist} tests if an object has the class \code{'edgelist'} #' #' #' @aliases edgelist #' @param x a \code{network} object with additional class added indicating how #' it should be dispatched. #' @param output return type: a \code{\link{matrix}} or a \code{\link{tibble}}; #' see \code{\link{as.matrix.network}} for the difference. #' @param attrname optionally, the name of an edge attribute to use for edge #' values; may be a vector of names if \code{output="tibble"} #' @param as.sna.edgelist logical; should the edgelist be returned in edgelist #' form expected by the sna package? Ignored if \code{output="tibble"} #' @param n integer number of vertices in network, value passed to the 'n' flag #' on edgelist returned #' @param vnames vertex names (defaults to vertex ids) to be attached to #' edgelist for sna package compatibility #' @param directed logical; is network directed, value passed to the 'directed' #' flag on edgelist returned #' @param bipartite logical or integer; is network bipartite, value passed to #' the 'bipartite' flag on edgelist returned #' @param loops logical; are self-loops allowed in network?, value passed to #' the 'loops' flag on edgelist returned #' @param \dots additional arguments to other methods #' @return A matrix in which the first two columns are integers giving the tail #' (source) and head (target) vertex ids of each edge. The matrix will be given #' the class \code{edgelist}. #' #' The edgelist has additional attributes attached to it: \itemize{ \item #' \code{attr(,"n")} the number of vertices in the original network #' #' \item \code{attr(,"vnames")} the names of vertices in the original network #' #' \item \code{attr(,"directed")} logical, was the original network directed #' #' \item \code{attr(,"bipartite")} was the original network bipartite #' #' \item \code{attr(,"loops")} does the original network contain self-loops } #' #' Note that if the \code{attrname} attribute is used the resulting edgelist #' matrix will have three columns. And if \code{attrname} refers to a #' character attribute, the resulting edgelist matrix will be character rather #' than numeric unless \code{output="tibble"}. #' #' @note NOTE: this function was moved to network from the ergm package in #' network version 1.13 #' @seealso See also \code{\link{as.matrix.network.edgelist}} #' @examples #' #' data(emon) #' as.edgelist(emon[[1]]) #' as.edgelist(emon[[1]],output="tibble") #' # contrast with unsorted columns of #' as.matrix.network.edgelist(emon[[1]]) #' #' @export as.edgelist.network <- function(x, attrname = NULL, as.sna.edgelist = FALSE, output=c("matrix","tibble"), ...){ output <- match.arg(output) switch(output, matrix = as.edgelist(as.matrix.network.edgelist(x, attrname=attrname, as.sna.edgelist=as.sna.edgelist,...), n=network.size(x), directed=is.directed(x), bipartite=ifelse(is.bipartite(x),x%n%"bipartite",FALSE), loops=has.loops(x), vnames=network.vertex.names(x)), tibble = as.edgelist(as_tibble(x, attrnames=attrname,...), n=network.size(x), directed=is.directed(x), bipartite=ifelse(is.bipartite(x),x%n%"bipartite",FALSE), loops=has.loops(x), vnames=network.vertex.names(x)) ) } #' @rdname as.edgelist #' @export as.edgelist.matrix #' @export as.edgelist.matrix <- function(x, n, directed=TRUE, bipartite=FALSE, loops=FALSE, vnames=seq_len(n),...){ if(!directed) x[,1:2] <- cbind(pmin(x[,1],x[,2]),pmax(x[,1],x[,2])) if(!loops) x <- x[x[,1]!=x[,2],,drop=FALSE] if(bipartite) x <- x[(x[,1]<=bipartite)!=(x[,2]<=bipartite),,drop=FALSE] x <- unique(x[order(x[,1],x[,2]),,drop=FALSE]) attr(x,"n") <- as.integer(n) attr(x,"vnames")<- vnames attr(x,"directed") <- as.logical(directed) attr(x,"bipartite") <- if(is.numeric(bipartite)) as.integer(bipartite) else bipartite attr(x,"loops") <- as.logical(loops) class(x)<-c('matrix_edgelist','edgelist',class(x)) x } #' @rdname as.edgelist #' @export as.edgelist.tbl_df <- function(x, n, directed=TRUE, bipartite=FALSE, loops=FALSE, vnames=seq_len(n),...){ if(!directed){ x$.tail <- pmin(t <- x$.tail, x$.head) x$.head <- pmax(t, x$.head) # .tail has been clobbered. } if(!loops) x <- x[x$.tail!=x$.head,] if(bipartite) x <- x[(x$.tail<=bipartite)!=(x$.head<=bipartite),] x <- unique(x[order(x$.tail, x$.head),]) attr(x,"n") <- as.integer(n) attr(x,"vnames")<- vnames attr(x,"directed") <- as.logical(directed) attr(x,"bipartite") <- if(is.numeric(bipartite)) as.integer(bipartite) else bipartite attr(x,"loops") <- as.logical(loops) class(x)<-c('tibble_edgelist','edgelist',class(x)) x } #' @rdname as.edgelist #' @export is.edgelist is.edgelist<-function(x){ inherits(x,"edgelist") } network/R/dataframe.R0000644000176200001440000005614513740520334014227 0ustar liggesusers#' @importFrom statnet.common once .warn_bipartite_vertex_reorder <- once( function() { warning( "`vertices` were not provided in the order required for bipartite networks. Reordering.", "\n\nThis is the first and last time you will be warned during this session.", call. = FALSE ) } ) .head <- function(x, n = 6) { n <- min(length(x), n) x[seq_len(n)] } .validate_edge_df <- function(edges, directed, hyper, loops, multiple, bipartite, ...) { # confirm edge data frame has valid dimensions if (ncol(edges) < 2L || nrow(edges) == 0L) { stop( "`x` should be a data frame with at least two columns and one row.", call. = FALSE ) } el <- edges[, 1:2] sources <- edges[[1L]] targets <- edges[[2L]] # validate edge column types if (hyper) { # confirm that hyper-edges are list columns if (!is.list(sources) || !is.list(targets)) { stop( "If `hyper` is `TRUE`, the first two columns of `x` should be list columns.", call. = FALSE ) } # first edge type is the `target_type`, against which all other values are tested target_type <- typeof(sources[[1L]]) # confirm that target_type is itself valid if (any(is.na(sources[[1L]])) || target_type %in% c("NULL", "list")) { stop( "`x`'s first two columns contain invalid values.", "\n\t- `x[[1]][[1]]` is `NULL`, recursive, or it contains `NA` values.", call. = FALSE ) } # Iterate through edge columns, testing that they're not `NA` and are of the same type # as `target_type`. `incompat_types` is a logical matrix of the test results. incompat_types <- vapply( el, function(.x) { vapply(.x, function(.y) any(is.na(.y)) || typeof(.y) != target_type, logical(1L)) }, logical(nrow(el)) ) # if any values are incompatible, throw error pointing user to the problem values if (any(incompat_types)) { incompat_rows <- row(incompat_types)[incompat_types] incompat_cols <- col(incompat_types)[incompat_types] stop( "The values in the first two columns of `x` must be of the same type and cannot be `NULL`, `NA`, or recursive values.", "\nThe following values are incompatible:", paste( "\n\t-", sprintf("`x[%d, %d]`", .head(incompat_rows), .head(incompat_cols)) ), call. = FALSE ) } } else { # for non-hyper edges... # ... confirm edge columns are atomic vectors if (!is.atomic(sources) || !is.atomic(targets)) { stop( "If `hyper` is `FALSE`, the first two columns of `x` should be atomic vectors.", call. = FALSE ) } # confirm that edge columns are of the same type if (typeof(sources) != typeof(targets)) { stop( "The first two columns of `x` must be of the same type.", call. = FALSE ) } # confirm edge columns don't contain `NA`s if (any(is.na(el))) { stop( "The first two columns of `x` cannot contain `NA` values.", call. = FALSE ) } } # if `loops` is `FALSE`, confirm that edge columns don't contain loops if (!loops) { # if hyper, test if each intersection's length is not 0 if (hyper) { loop_rows <- which( mapply( function(.x, .y) length(intersect(.x, .y)) != 0L, sources, targets, USE.NAMES = FALSE ) ) } else { # if not hyper... # ... test via simple vector comparison loop_rows <- which(sources == targets) } # if loops are found, throw error pointing user to the edge rows that contain them if (length(loop_rows) > 0L) { stop( "`loops` is `FALSE`, but `x` contains loops.", "\nThe following values are affected:", paste("\n\t-", sprintf("`x[%d, 1:2]`", .head(loop_rows))), call. = FALSE ) } } # TODO does network support bipartite hypergraphs? if (!hyper && bipartite) { # check for intersection between edge columns confused_nodes <- intersect(sources, targets) # if there's an intersection, throw error informing users which nodes are in both columns if (length(confused_nodes) > 0L) { stop( "`bipartite` is `TRUE`, but there are vertices that appear in both of the", " first two columns of `x`.\n", "The following vertices appear in both columns:", paste("\n\t-", .head(confused_nodes)), call. = FALSE ) } } # TODO does network support multiplex hypergraphs? if (!hyper && !multiple) { if (directed) { test_el <- el } else { test_el <- t(apply(el, 1L, sort)) } if (anyDuplicated(test_el) != 0L) { parallel_edges <- which(duplicated(test_el)) stop( "`multiple` is `FALSE`, but `x` contains parallel edges.\n", "The following rows in `x` are duplicated:", paste("\n\t-", sprintf("`x[%d, ]`", .head(parallel_edges))), call. = FALSE ) } } } .validate_vertex_df <- function(vertices, el_vert_ids) { # confirm `vertices` is a data frame if (!is.data.frame(vertices)) { stop( "If provided, `vertices` should be a data frame.", call. = FALSE ) } # confirm `vertices` has valid dimensions if (nrow(vertices) == 0L || ncol(vertices) == 0L) { stop( "`vertices` should contain at least one column and row.", call. = FALSE ) } vertex_ids <- vertices[[1L]] if (!is.atomic(vertex_ids)) { stop( "The first column of `vertices` must be an atomic vector.", call. = FALSE ) } # confirm vertex IDs match type used in edges if (typeof(vertex_ids) != typeof(el_vert_ids)) { stop( "The first column of `vertices` must be the same type as the value with which", " they are referenced in `x`'s first two columns.", call. = FALSE ) } # check for vertex names that are in the edges, but are missing from `vertices` missing_vertex_names <- setdiff(el_vert_ids, vertex_ids) if (length(missing_vertex_names) != 0L) { stop( "The following vertices are in `x`, but not in `vertices`:", paste("\n\t-", .head(missing_vertex_names)), call. = FALSE ) } # check if any of the `vertices` have duplicate names if (anyDuplicated(vertex_ids) != 0L) { stop( "The following vertex names are duplicated in `vertices`:", paste("\n\t-", .head(vertex_ids[duplicated(vertex_ids)])), call. = FALSE ) } } .prep_bipartite_vertices <- function(vertices, el_vert_ids, bipartite_col) { # use "is_actor" column if provided if (bipartite_col %in% names(vertices)) { # check if `"is_actor"` column is valid if (!is.logical(vertices[[bipartite_col]]) || any(is.na(vertices[[bipartite_col]]))) { stop( sprintf( paste0( '`bipartite` is `TRUE` and vertex types are specified via a column in `vertices` named `"%s"`.', '\n\t- If provided, all values in `vertices[["%s"]]` must be `TRUE` or `FALSE`.' ), bipartite_col, bipartite_col ) ) } # actors (`TRUE`) go before non-actors (`FALSE`) vertex_order <- order(vertices[[bipartite_col]], decreasing = TRUE) } else { # if no "is_actor" column is provided... vertex_ids <- vertices[[1L]] # ... check for isolates... isolates <- setdiff(vertex_ids, el_vert_ids) # ... and throw error informing user of which vertices are isolates if (length(isolates) > 0L) { stop( sprintf( "`bipartite` is `TRUE`, but the `vertices` you provided contain names that are not present in `x` (i.e. you have isolates).", "\nIf you have isolates, `vertices` must have a `logical` column named \"%s\" indicating each vertex's type.", "\nThe following vertex names are in `vertices`, but not in `x`:", bipartite_col ), paste("\n\t-", .head(isolates)) ) } # if there are no isolates, follow order of vertices as they appear in the edges vertex_order <- match(el_vert_ids, vertex_ids) } if (!identical(vertices[[1L]], vertices[[1L]][vertex_order])) { .warn_bipartite_vertex_reorder() } # reorder the vertex rows to match the actor/non-actor order of the final network vertices[vertex_order, ] } .distribute_vec_attrs <- function(x) { lapply(x, function(.x) { if (is.atomic(.x)) { lapply(.x, `attributes<-`, attributes(.x)) } else { .x } }) } .prep_edge_attrs <- function(edges) { edge_attr_names <- names(edges)[-(1:2)] init_vals_eval <- .distribute_vec_attrs(edges[, edge_attr_names, drop = FALSE]) list( names_eval = rep(list(as.list(edge_attr_names)), times = nrow(edges)), vals_eval = .mapply(list, init_vals_eval, NULL) ) } .prep_vertex_attrs <- function(vertices) { vertices[-1L] <- .distribute_vec_attrs(vertices[-1L]) vertices } #' @rdname network #' #' @param vertices If \code{x} is a \code{data.frame}, \code{vertices} is an optional #' \code{data.frame} containing the vertex attributes. The first column is assigned #' to the \code{"vertex.names"} and additional columns are used to set vertex attributes #' using their column names. If \code{bipartite} is \code{TRUE}, a \code{logical} column #' named \code{"is_actor"} (or the name of a column specified using the #' \code{bipartite_col} parameter) can be provided indicating which vertices #' should be considered as actors. If not provided, vertices referenced in the #' first column of \code{x} are assumed to be the network's actors. If your #' network has isolates (i.e. there are vertices referenced in \code{vertices} #' that are not referenced in \code{x}), the \code{"is_actor"} column is required. #' #' @param bipartite_col \code{character(1L)}, default: \code{"is_actor"}. #' The name of the \code{logical} column indicating which vertices should be #' considered as actors in bipartite networks. #' #' @examples #' # networks from data frames =========================================================== #' #* simple networks ==================================================================== #' simple_edge_df <- data.frame( #' from = c("b", "c", "c", "d", "a"), #' to = c("a", "b", "a", "a", "b"), #' weight = c(1, 1, 2, 2, 3), #' stringsAsFactors = FALSE #' ) #' simple_edge_df #' #' as.network(simple_edge_df) #' #' # simple networks with vertices ======================================================= #' simple_vertex_df <- data.frame( #' name = letters[1:5], #' residence = c("urban", "rural", "suburban", "suburban", "rural"), #' stringsAsFactors = FALSE #' ) #' simple_vertex_df #' #' as.network(simple_edge_df, vertices = simple_vertex_df) #' #' as.network(simple_edge_df, #' directed = FALSE, vertices = simple_vertex_df, #' multiple = TRUE #' ) #' #' #* splitting multiplex data frames into multiple networks ============================= #' simple_edge_df$relationship <- c(rep("friends", 3), rep("colleagues", 2)) #' simple_edge_df #' #' lapply(split(simple_edge_df, f = simple_edge_df$relationship), #' as.network, #' vertices = simple_vertex_df #' ) #' #' #* bipartite networks without isolates ================================================ #' bip_edge_df <- data.frame( #' actor = c("a", "a", "b", "b", "c", "d", "d", "e"), #' event = c("e1", "e2", "e1", "e3", "e3", "e2", "e3", "e1"), #' actor_enjoyed_event = rep(c(TRUE, FALSE), 4), #' stringsAsFactors = FALSE #' ) #' bip_edge_df #' #' bip_node_df <- data.frame( #' node_id = c("a", "e1", "b", "e2", "c", "e3", "d", "e"), #' node_type = c( #' "person", "event", "person", "event", "person", #' "event", "person", "person" #' ), #' color = c( #' "red", "blue", "red", "blue", "red", "blue", #' "red", "red" #' ), #' stringsAsFactors = FALSE #' ) #' bip_node_df #' #' as.network(bip_edge_df, directed = FALSE, bipartite = TRUE) #' as.network(bip_edge_df, directed = FALSE, vertices = bip_node_df, bipartite = TRUE) #' #' #* bipartite networks with isolates =================================================== #' bip_nodes_with_isolates <- rbind( #' bip_node_df, #' data.frame( #' node_id = c("f", "e4"), #' node_type = c("person", "event"), #' color = c("red", "blue"), #' stringsAsFactors = FALSE #' ) #' ) #' # indicate which vertices are actors via a column named `"is_actor"` #' bip_nodes_with_isolates$is_actor <- bip_nodes_with_isolates$node_type == "person" #' bip_nodes_with_isolates #' #' as.network(bip_edge_df, #' directed = FALSE, vertices = bip_nodes_with_isolates, #' bipartite = TRUE #' ) #' #' #* hyper networks from data frames ==================================================== #' hyper_edge_df <- data.frame( #' from = c("a/b", "b/c", "c/d/e", "d/e"), #' to = c("c/d", "a/b/e/d", "a/b", "d/e"), #' time = 1:4, #' stringsAsFactors = FALSE #' ) #' tibble::as_tibble(hyper_edge_df) #' #' # split "from" and "to" at `"/"`, coercing them to list columns #' hyper_edge_df$from <- strsplit(hyper_edge_df$from, split = "/") #' hyper_edge_df$to <- strsplit(hyper_edge_df$to, split = "/") #' tibble::as_tibble(hyper_edge_df) #' #' as.network(hyper_edge_df, #' directed = FALSE, vertices = simple_vertex_df, #' hyper = TRUE, loops = TRUE #' ) #' #' # convert network objects back to data frames ========================================= #' simple_g <- as.network(simple_edge_df, vertices = simple_vertex_df) #' as.data.frame(simple_g) #' as.data.frame(simple_g, unit = "vertices") #' #' bip_g <- as.network(bip_edge_df, #' directed = FALSE, vertices = bip_node_df, #' bipartite = TRUE #' ) #' as.data.frame(bip_g) #' as.data.frame(bip_g, unit = "vertices") #' #' hyper_g <- as.network(hyper_edge_df, #' directed = FALSE, vertices = simple_vertex_df, #' hyper = TRUE, loops = TRUE #' ) #' as.data.frame(hyper_g) #' as.data.frame(hyper_g, unit = "vertices") #' @export as.network.data.frame #' @export as.network.data.frame <- function(x, directed = TRUE, vertices = NULL, hyper = FALSE, loops = FALSE, multiple = FALSE, bipartite = FALSE, bipartite_col = "is_actor", ...) { # validate network type args invalid_network_args <- vapply( list( directed = directed, hyper = hyper, loops = loops, multiple = multiple, bipartite = bipartite ), function(.x) is.na(.x) || !is.logical(.x), logical(1L) ) if (any(invalid_network_args)) { stop( "The following arguments must be either `TRUE` or `FALSE`:", paste("\n\t-", names(invalid_network_args)[invalid_network_args]) ) } if (length(bipartite_col) != 1L || !is.character(bipartite_col) || is.na(bipartite_col)) { stop("`bipartite_col` must be a single, non-`NA` `character` value.") } # handle incompatible network type args if (bipartite && directed) { warning("If `bipartite` is `TRUE`, edges are interpreted as undirected.") directed <- FALSE } if (bipartite && loops) { warning("If `bipartite` is `TRUE`, `loops` must be `FALSE`.") loops <- FALSE } if (hyper && !directed && !loops) { warning("If `hyper` is `TRUE` and `directed` is `FALSE`, `loops` must be `TRUE`.") loops <- TRUE } if (hyper && bipartite) { stop("Both `hyper` and `bipartite` are `TRUE`, but bipartite hypergraphs are not supported.") } # validate edges .validate_edge_df( edges = x, directed = directed, hyper = hyper, loops = loops, multiple = multiple, bipartite = bipartite ) # create variable containing vertex IDs in the order they appear in the edges vertex_ids_in_el <- unique(unlist(x[, 1:2], use.names = FALSE)) # create reference variables to minimize bracket spam sources <- x[[1L]] targets <- x[[2L]] # validate vertices if (!is.null(vertices)) { .validate_vertex_df(vertices, el_vert_ids = vertex_ids_in_el) } # if vertices aren't provided, use the order in which they appear in the edges if (is.null(vertices)) { vertex_names <- vertex_ids_in_el } else { # if vertices are provided, use that order if (bipartite) { # if bipartite, first reorder vertices so actors come before non-actors vertices <- .prep_bipartite_vertices(vertices, el_vert_ids = vertex_ids_in_el, bipartite_col = bipartite_col) } vertex_names <- vertices[[1L]] } # out_sources/out_targets consist of the numerical indices to add to the final network out_sources <- lapply(sources, match, vertex_names) out_targets <- lapply(targets, match, vertex_names) # prep edge attributes if (ncol(x) == 2L) { edge_attrs <- list(names_eval = NULL, vals_eval = NULL) } else { edge_attrs <- .prep_edge_attrs(x) } # start building the network to return out <- network.initialize( n = length(vertex_names), directed = directed, hyper = hyper, loops = loops, multiple = multiple, bipartite = if (bipartite) length(unique(sources)) else FALSE ) # add edges (and any edge attributes) out <- add.edges.network( x = out, tail = out_sources, head = out_targets, names.eval = edge_attrs[["names_eval"]], vals.eval = edge_attrs[["vals_eval"]], ... ) # set vertex attributes if (is.null(vertices)) { # if vertices aren't provided, set "vertex.names" as the values used in edges out <- set.vertex.attribute(out, attrname = "vertex.names", value = vertex_names) } else if (ncol(vertices) == 1L) { out <- set.vertex.attribute(out, attrname = "vertex.names", value = vertices[[1L]]) } else { out <- set.vertex.attribute( x = out, attrname = c( "vertex.names", # first column is always "vertex.names" names(vertices)[-1L] ), value = .prep_vertex_attrs(vertices) ) } out } .is_atomic_scalar <- function(x) { is.atomic(x) && length(x) == 1L } .all_are_atomic_scalars <- function(x) { all(vapply(x, .is_atomic_scalar, logical(1L), USE.NAMES = FALSE)) } .is_vectorizable <- function(x) { vapply(x, .all_are_atomic_scalars, logical(1L), USE.NAMES = FALSE) } .vectorize_safely <- function(x) { to_vectorize <- .is_vectorizable(x) x[to_vectorize] <- lapply(x[to_vectorize], function(.x) { `attributes<-`(unlist(.x, use.names = FALSE), attributes(.x[[1L]])) }) x } .as_edge_df <- function(x, attrs_to_ignore, na.rm, ...) { if (network.edgecount(x) == 0L) { empty_edge_df <- structure( list(.tail = logical(), .head = logical(), .na = logical()), row.names = integer(), class = "data.frame" ) if ("na" %in% attrs_to_ignore) { empty_edge_df <- empty_edge_df[, c(".tail", ".head")] } return(empty_edge_df) } vertex_names <- network.vertex.names(x) el_list <- list( .tail = lapply(x[["mel"]], function(.x) vertex_names[.x[["outl"]]]), .head = lapply(x[["mel"]], function(.x) vertex_names[.x[["inl"]]]) ) # list.edge.attributes() sorts, meaning we can't test round-trips edge_attr_names <- unique( unlist(lapply(x[["mel"]], function(.x) names(.x[["atl"]])), use.names = FALSE ) ) names(edge_attr_names) <- edge_attr_names # extract attributes as-is (lists) edge_attrs <- lapply( edge_attr_names, function(.x) get.edge.attribute(x, .x, unlist = FALSE) ) # if not `TRUE`, "na" is assumed `FALSE` (in the event of `NULL`s or corrupted data) edge_attrs[["na"]] <- !vapply( edge_attrs[["na"]], isFALSE, logical(1L), USE.NAMES = FALSE ) # skip `base::as.data.frame()`'s auto-unlisting behavior out <- structure( c(el_list, edge_attrs), row.names = seq_along(el_list[[1L]]), class = "data.frame" ) if (na.rm) { # drop NA edge rows out <- out[!out[["na"]], ] # reset `rownames()` so they're sequential in returned object rownames(out) <- NULL } else if (!is.hyper(x)) { # replace empty ".tail" and ".head" with `NA` so that the columns can be safely # vectorized for non-hyper edges when `na.rm` is `FALSE` out[1:2] <- lapply(out[1:2], lapply, function(.x) if (length(.x)) .x else NA) } cols_to_keep <- c(".tail", ".head", setdiff(names(edge_attrs), attrs_to_ignore)) out <- out[cols_to_keep] # if not hyper, `unlist()` ".tail" and ".head" if (!is.hyper(x)) { out[1:2] <- lapply(out[1:2], unlist, use.names = FALSE) } # safely vectorize non-edgelist columns cols_to_vectorize <- setdiff(names(out), c(".tail", ".head")) if (length(cols_to_vectorize)) { out[cols_to_vectorize] <- .vectorize_safely(out[cols_to_vectorize]) } out } .as_vertex_df <- function(x, attrs_to_ignore, na.rm, ...) { if (network.size(x) == 0L) { empty_vertex_df <- structure( list(vertex.names = logical(), na = logical()), class = "data.frame", row.names = integer() ) if ("na" %in% attrs_to_ignore) { empty_vertex_df <- empty_vertex_df[, "vertex.names", drop = FALSE] } return(empty_vertex_df) } # list.vertex.attributes() sorts the result, meaning we can't test round-trips vertex_attr_names <- unique(unlist(lapply(x[["val"]], names), use.names = FALSE)) vertex_attrs <- lapply( `names<-`(vertex_attr_names, vertex_attr_names), function(.x) get.vertex.attribute(x, .x, unlist = FALSE) ) vertex_attrs[["na"]] <- lapply( vertex_attrs[["na"]], function(.x) if (is.null(.x)) TRUE else .x ) out <- structure( vertex_attrs, row.names = seq_len(network.size(x)), class = "data.frame" ) if (!"vertex.names" %in% names(out)) { out[["vertex.names"]] <- network.vertex.names(x) } if (na.rm) { out <- out[!vapply(out[["na"]], isTRUE, logical(1L), USE.NAMES = FALSE), ] rownames(out) <- NULL } out_cols <- c( "vertex.names", setdiff(names(out), c("vertex.names", attrs_to_ignore)) ) .vectorize_safely(out[, out_cols, drop = FALSE]) } #' Coerce a Network Object to a \code{data.frame} #' #' The \code{as.data.frame} method coerces its input to a \code{data.frame} containing #' \code{x}'s edges or vertices. #' #' @param x an object of class \code{network} #' @param ... additional arguments #' @param unit whether a \code{data.frame} of edge or vertex attributes #' should be returned. #' @param na.rm logical; ignore missing entries when constructing the data frame? #' @param attrs_to_ignore character; a vector of attribute names to exclude from #' the returned \code{data.frame} (Default: \code{"na"}) #' #' @export as.data.frame.network #' @export as.data.frame.network <- function(x, ..., unit = c("edges", "vertices"), na.rm = TRUE, attrs_to_ignore = "na") { if (inherits(x, "network", which = TRUE) != length(class(x))) { warning( # nocov start '`x` may not correctly inherit from class "network".', sprintf("\n\t- `class(x)`: `%s", deparse(class(x))) ) # nocov end } switch(match.arg(unit, c("edges", "vertices")), edges = .as_edge_df( x, attrs_to_ignore = attrs_to_ignore, na.rm = na.rm, ... ), vertices = .as_vertex_df( x, attrs_to_ignore = attrs_to_ignore, na.rm = na.rm, ... ), # `match.arg()` used, so this should never be reached... stop('`unit` must be one of `"edges"` or `"vertices".') # nocov ) } network/R/operators.R0000644000176200001440000015077614057075374014341 0ustar liggesusers###################################################################### # # operators.R # # Written by Carter T. Butts ; portions contributed by # David Hunter and Mark S. Handcock # . # # Last Modified 06/06/21 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains various operators which take networks as inputs. # # Contents: # # "$<-.network" # "[.network" # "[<-.network" # "%e%" # "%e%<-" # "%eattr%" # "%eattr%<-" # "%n%" # "%n%<-" # "%nattr%" # "%nattr%<-" # "%s%" # "%v%" # "%v%<-" # "%vattr%" # "%vattr%<-" # "+" # "+.default" # "+.network" # "-" # "-.default" # "-.network" # "*" # "*.default" # "*.network" # "!.network" # "|.network" # "&.network" # "%*%.network" # "%c%" # "%c%.network" # networkOperatorSetup # prod.network # sum.network # ###################################################################### # removed this function because it appears that '<-' is no longer a generic in R, so it was never getting called and the copy was not being made. See ticket #550 #' @export "<-.network" "<-.network"<-function(x,value){ .Deprecated("network.copy or '<-' works just fine",msg="The network assignment S3 method '<-.network' has been deprecated because the operator '<-' is no longer an S3 generic in R so the .network version does not appear to be called. If you see this warning, please contact the maintainers to let us know you use this function") x<-network.copy(value) return(x) } # A helper function to check that a particular edgelist can be validly queried or assigned to. #' @importFrom statnet.common NVL out_of_bounds <- function(x, el){ n <- network.size(x) bip <- NVL(x%n%"bipartite", FALSE) anyNA(el) || any(el<1L) || any(el>n) || (bip && (any((el[,1]<=bip) == (el[,2]<=bip)))) } # removed so that will dispatch to internal primitive method #642 #"$<-.network"<-function(x,i,value){ # cl<-oldClass(x) # class(x)<-NULL # x[[i]]<-value # class(x)<-cl # return(x) #} #' Extraction and Replacement Operators for Network Objects #' #' Various operators which allow extraction or replacement of various #' components of a \code{network} object. #' #' Indexing for edge extraction operates in a manner analogous to \code{matrix} #' objects. Thus, \code{x[,]} selects all vertex pairs, \code{x[1,-5]} selects #' the pairing of vertex 1 with all vertices except for 5, etc. Following #' this, it is acceptable for \code{i} and/or \code{j} to be logical vectors #' indicating which vertices are to be included. During assignment, an attempt #' is made to match the elements of \code{value} to the extracted pairs in an #' intelligent way; in particular, elements of \code{value} will be replicated #' if too few are supplied (allowing expressions like \code{x[1,]<-1}). Where #' \code{names.eval==NULL}, zero and non-zero values are taken to indicate the #' presence of absence of edges. \code{x[2,4]<-6} thus adds a single (2,4) #' edge to \code{x}, and \code{x[2,4]<-0} removes such an edge (if present). #' If \code{x} is multiplex, assigning 0 to a vertex pair will eliminate #' \emph{all} edges on that pair. Pairs are taken to be directed where #' \code{is.directed(x)==TRUE}, and undirected where #' \code{is.directed(x)==FALSE}. #' #' If an edge attribute is specified using \code{names.eval}, then the provided #' values will be assigned to that attribute. When assigning values, only #' extant edges are employed (unless \code{add.edges==TRUE}); in the latter #' case, any non-zero assignment results in the addition of an edge where #' currently absent. If the attribute specified is not present on a given #' edge, it is added. Otherwise, any existing value is overwritten. The #' \code{\%e\%} operator can also be used to extract/assign edge values; in those #' roles, it is respectively equivalent to \code{get.edge.value(x,attrname)} #' and \code{set.edge.value(x,attrname=attrname,value=value)} (if \code{value} #' is a matrix) and \code{set.edge.attribute(x,attrname=attrname,value=value)} #' (if \code{value} is anything else). That is, if \code{value} is a matrix, #' the assignment operator treats it as an adjacency matrix; and if not, it #' treats it as a vector (recycled as needed) in the internal ordering of edges #' (i.e., edge IDs), skipping over deleted edges. In no case will attributes be #' assigned to nonexisted edges. #' #' The \code{\%n\%} and \code{\%v\%} operators serve as front-ends to the network #' and vertex extraction/assignment functions (respectively). In the #' extraction case, \code{x \%n\% attrname} is equivalent to #' \code{get.network.attribute(x,attrname)}, with \code{x \%v\% attrname} #' corresponding to \code{get.vertex.attribute(x,attrname)}. In assignment, #' the respective equivalences are to #' \code{set.network.attribute(x,attrname,value)} and #' \code{set.vertex.attribute(x,attrname,value)}. Note that the `%%` #' assignment forms are generally slower than the named versions of the #' functions beause they will trigger an additional internal copy of the #' network object. #' #' The \code{\%eattr\%}, \code{\%nattr\%}, and \code{\%vattr\%} operators are #' equivalent to \code{\%e\%}, \code{\%n\%}, and \code{\%v\%} (respectively). The #' short forms are more succinct, but may produce less readable code. #' #' @name network.extraction #' #' @param x an object of class \code{network}. #' @param i,j indices of the vertices with respect to which adjacency is to be #' tested. Empty values indicate that all vertices should be employed (see #' below). #' @param na.omit logical; should missing edges be omitted (treated as #' no-adjacency), or should \code{NA}s be returned? (Default: return \code{NA} #' on missing.) #' @param names.eval optionally, the name of an edge attribute to use for #' assigning edge values. #' @param add.edges logical; should new edges be added to \code{x} where edges #' are absent and the appropriate element of \code{value} is non-zero? #' @param value the value (or set thereof) to be assigned to the selected #' element of \code{x}. #' @param attrname the name of a network or vertex attribute (as appropriate). #' @return The extracted data, or none. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{is.adjacent}}, \code{\link{as.sociomatrix}}, #' \code{\link{attribute.methods}}, \code{\link{add.edges}}, #' \code{\link{network.operators}}, and \code{\link{get.inducedSubgraph}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @keywords graphs manip #' @examples #' #' #Create a random graph (inefficiently) #' g<-network.initialize(10) #' g[,]<-matrix(rbinom(100,1,0.1),10,10) #' plot(g) #' #' #Demonstrate edge addition/deletion #' g[,]<-0 #' g[1,]<-1 #' g[2:3,6:7]<-1 #' g[,] #' #' #Set edge values #' g[,,names.eval="boo"]<-5 #' as.sociomatrix(g,"boo") #' #Assign edge values from a vector #' g %e% "hoo" <- "wah" #' g %e% "hoo" #' g %e% "om" <- c("wow","whee") #' g %e% "om" #' #Assign edge values as a sociomatrix #' g %e% "age" <- matrix(1:100, 10, 10) #' g %e% "age" #' as.sociomatrix(g,"age") #' #' #Set/retrieve network and vertex attributes #' g %n% "blah" <- "Pork!" #The other white meat? #' g %n% "blah" == "Pork!" #TRUE! #' g %v% "foo" <- letters[10:1] #Letter the vertices #' g %v% "foo" == letters[10:1] #All TRUE #' #' @export "[.network" #' @export "[.network"<-function(x,i,j,na.omit=FALSE){ narg<-nargs()+missing(na.omit) n<-network.size(x) bip <- x%n%"bipartite" xnames <- network.vertex.names(x) if(missing(i)){ #If missing, use 1:n i <- if(is.bipartite(x)) 1:bip else 1:n } if((narg>3)&&missing(j)){ j <- if(is.bipartite(x)) (bip+1L):n else 1:n } if(is.matrix(i)&&(NCOL(i)==1)) #Vectorize if degenerate matrix i<-as.vector(i) if(is.matrix(i)){ #Still a matrix? if(is.logical(i)){ #Subset w/T/F? j<-col(i)[i] i<-row(i)[i] if(out_of_bounds(x, cbind(i,j))) stop("subscript out of bounds") out<-is.adjacent(x,i,j,na.omit=na.omit) }else{ #Were we passed a pair list? if(is.character(i)) i<-apply(i,c(1,2),match,xnames) if(out_of_bounds(x, i)) stop("subscript out of bounds") out<-is.adjacent(x,i[,1],i[,2], na.omit=na.omit) } }else if((narg<3)&&missing(j)){ #Here, assume a list of cell numbers ir<-1+((i-1)%%n) ic<-1+((i-1)%/%n) if(out_of_bounds(x, cbind(ir,ic))) stop("subscript out of bounds") out<-is.adjacent(x,ir,ic,na.omit=na.omit) }else{ #Otherwise, assume a vector or submatrix if(is.character(i)) i<-match(i,xnames) if(is.character(j)) j<-match(j,xnames) i<-(1:n)[i] #Piggyback on R's internal tricks j<-(1:n)[j] if(length(i)==1){ if(out_of_bounds(x, cbind(i,j))) stop("subscript out of bounds") out<-is.adjacent(x,i,j,na.omit=na.omit) }else{ if(length(j)==1){ if(out_of_bounds(x, cbind(i,j))) stop("subscript out of bounds") out<-is.adjacent(x,i,j,na.omit=na.omit) }else{ jrep<-rep(j,rep.int(length(i),length(j))) if(length(i)>0) irep<-rep(i,times=ceiling(length(jrep)/length(i))) if(out_of_bounds(x, cbind(irep,jrep))) stop("subscript out of bounds") out<-matrix(is.adjacent(x,irep,jrep,na.omit=na.omit), length(i),length(j)) } } if((!is.null(xnames))&&is.matrix(out)) dimnames(out) <- list(xnames[i],xnames[j]) } out+0 #Coerce to numeric } #' @rdname network.extraction #' @export "[<-.network" #' @export "[<-.network"<-function(x,i,j,names.eval=NULL,add.edges=FALSE,value){ #For the common special case of x[,] <- 0, delete edges quickly by #reconstructing new outedgelists, inedgelists, and edgelists, #leaving the old ones to the garbage collector. if(missing(i) && missing(j) && is.null(names.eval) && isTRUE(all(value==FALSE))){ if(length(x$mel)==0 || network.edgecount(x,na.omit=FALSE)==0) return(x) # Nothing to do; note that missing edges are still edges for the purposes of this. x$oel <- rep(list(integer(0)), length(x$oel)) x$iel <- rep(list(integer(0)), length(x$iel)) x$mel <- list() x$gal$mnext <- 1 return(x) } #Check for hypergraphicity if(is.hyper(x)) stop("Assignment operator overloading does not currently support hypergraphic networks."); #Set up the edge list to change narg<-nargs()+missing(names.eval)+missing(add.edges) n<-network.size(x) xnames <- network.vertex.names(x) bip <- x%n%"bipartite" if(missing(i)){ #If missing, use 1:n i <- if(is.bipartite(x)) 1:bip else 1:n } if((narg>5)&&missing(j)){ j <- if(is.bipartite(x)) (bip+1L):n else 1:n } if(is.matrix(i)&&(NCOL(i)==1)) #Vectorize if degenerate matrix i<-as.vector(i) if(is.matrix(i)){ #Still a matrix? if(is.logical(i)){ #Subset w/T/F? j<-col(i)[i] i<-row(i)[i] el<-cbind(i,j) }else{ #Were we passed a pair list? if(is.character(i)) i<-apply(i,c(1,2),match,xnames) el<-i } }else if((narg<6)&&missing(j)){ #Here, assume a list of cell numbers el<-1+cbind((i-1)%%n,(i-1)%/%n) }else{ #Otherwise, assume a vector or submatrix if(is.character(i)) i<-match(i,xnames) if(is.character(j)) j<-match(j,xnames) i<-(1:n)[i] #Piggyback on R's internal tricks j<-(1:n)[j] if(length(i)==1){ el<-cbind(rep(i,length(j)),j) }else{ if(length(j)==1) el<-cbind(i,rep(j,length(i))) else{ jrep<-rep(j,rep.int(length(i),length(j))) if(length(i)>0) irep<-rep(i,times=ceiling(length(jrep)/length(i))) el<-cbind(irep,jrep) } } } # Check bounds if(out_of_bounds(x, el)) stop("subscript out of bounds") #Set up values if(is.matrix(value)) val<-value[cbind(match(el[,1],sort(unique(el[,1]))), match(el[,2],sort(unique(el[,2]))))] else val<-rep(as.vector(value),length=NROW(el)) #Perform the changes if(is.null(names.eval)){ #If no names given, don't store values for (k in seq_along(val)) { eid <- get.edgeIDs(x,el[k,1],el[k,2],neighborhood="out", na.omit=FALSE) if (!is.na(val[k]) & val[k] == 0) { # delete edge if (length(eid) > 0) x<-delete.edges(x,eid) } else { if (length(eid) == 0 & (has.loops(x)|(el[k,1]!=el[k,2]))) { # add edge if needed x<-add.edges(x,as.list(el[k,1]),as.list(el[k,2])) eid <- get.edgeIDs(x,el[k,1],el[k,2],neighborhood="out", na.omit=FALSE) } if (is.na(val[k])) { set.edge.attribute(x,"na",TRUE,eid) # set to NA } else if (val[k] == 1) { set.edge.attribute(x,"na",FALSE,eid) # set to 1 } } } }else{ #An attribute name was given, so store values epresent<-vector() eid<-vector() valsl<-list() for(k in 1:NROW(el)){ if(is.adjacent(x,el[k,1],el[k,2],na.omit=FALSE)){ #Collect extant edges loceid<-get.edgeIDs(x,el[k,1],el[k,2],neighborhood="out",na.omit=FALSE) if(add.edges){ #Need to know if we're adding/removing edges if(val[k]==0){ #If 0 and adding/removing, eliminate present edges x<-delete.edges(x,loceid) }else{ #Otherwise, add as normal valsl<-c(valsl,as.list(rep(val[k],length(loceid)))) eid<-c(eid,loceid) } }else{ valsl<-c(valsl,as.list(rep(val[k],length(loceid)))) eid<-c(eid,loceid) } epresent[k]<-TRUE }else epresent[k]<-!is.na(val[k]) && (val[k]==0) #If zero, skip it; otherwise (including NA), add } if(sum(epresent)>0) #Adjust attributes for extant edges x<-set.edge.attribute(x,names.eval,valsl,eid) if(add.edges&&(sum(!epresent)>0)) #Add new edges, if needed x<-add.edges(x,as.list(el[!epresent,1]),as.list(el[!epresent,2]), names.eval=as.list(rep(names.eval,sum(!epresent))),vals.eval=as.list(val[!epresent])) } #Return the modified graph x } #' @rdname network.extraction #' @export "%e%"<-function(x,attrname){ get.edge.value(x,attrname=attrname) } #' @rdname network.extraction #' @usage x \%e\% attrname <- value #' @export "%e%<-"<-function(x,attrname,value){ if(is.matrix(value)) set.edge.value(x,attrname=attrname,value=value) else set.edge.attribute(x,attrname=attrname,value=value,e=valid.eids(x)) } #' @rdname network.extraction #' @export "%eattr%"<-function(x,attrname){ x %e% attrname } #' @rdname network.extraction #' @usage x \%eattr\% attrname <- value #' @export "%eattr%<-"<-function(x,attrname,value){ x %e% attrname <- value } #' @rdname network.extraction #' @export "%n%"<-function(x,attrname){ get.network.attribute(x,attrname=attrname) } #' @rdname network.extraction #' @usage x \%n\% attrname <- value #' @export "%n%<-"<-function(x,attrname,value){ set.network.attribute(x,attrname=attrname,value=value) } #' @rdname network.extraction #' @export "%nattr%"<-function(x,attrname){ x %n% attrname } #' @rdname network.extraction #' @usage x \%nattr\% attrname <- value #' @export "%nattr%<-"<-function(x,attrname,value){ x %n% attrname <- value } #' @rdname get.inducedSubgraph #' @usage x \%s\% v #' @export "%s%"<-function(x,v){ if(is.list(v)) get.inducedSubgraph(x,v=v[[1]],alters=v[[2]]) else get.inducedSubgraph(x,v=v) } #' @rdname network.extraction #' @export "%v%"<-function(x,attrname){ get.vertex.attribute(x,attrname=attrname) } #' @rdname network.extraction #' @usage x \%v\% attrname <- value #' @export "%v%<-"<-function(x,attrname,value){ set.vertex.attribute(x,attrname=attrname,value=value) } #' @rdname network.extraction #' @export "%vattr%"<-function(x,attrname){ x %v% attrname } #' @rdname network.extraction #' @usage x \%vattr\% attrname <- value #' @export "%vattr%<-"<-function(x,attrname,value){ x %v% attrname <- value } #"+"<-function(e1, e2, ...) UseMethod("+") # #"+.default"<-function(e1,e2,...) { (base::"+")(e1,e2) } # #"+.network"<-function(e1,e2,attrname=NULL,...){ # e1<-as.sociomatrix(e1,attrname=attrname) # e2<-as.sociomatrix(e2,attrname=attrname) # network(e1+e2,ignore.eval=is.null(attrname),names.eval=attrname) #} #' Network Operators #' #' These operators allow for algebraic manipulation of relational structures. #' #' In general, the binary network operators function by producing a new network #' object whose edge structure is based on that of the input networks. The #' properties of the new structure depend upon the inputs as follows: \itemize{ #' \item The size of the new network is equal to the size of the input networks #' (for all operators save \code{\%c\%}), which must themselves be of equal size. #' Likewise, the \code{bipartite} attributes of the inputs must match, and this #' is preserved in the output. \item If either input network allows loops, #' multiplex edges, or hyperedges, the output acquires this property. (If both #' input networks do not allow these features, then the features are disallowed #' in the output network.) \item If either input network is directed, the #' output is directed; if exactly one input network is directed, the undirected #' input is treated as if it were a directed network in which all edges are #' reciprocated. \item Supplemental attributes (including vertex names, but #' not edgwise missingness) are not transferred to the output. } The unary #' operator acts per the above, but with a single input. Thus, the output #' network has the same properties as the input, with the exception of #' supplemental attributes. #' #' The behavior of the composition operator, \code{\%c\%}, is somewhat more #' complex than the others. In particular, it will return a bipartite network #' whenever either input network is bipartite \emph{or} the vertex names of the #' two input networks do not match (or are missing). If both inputs are #' non-bipartite and have identical vertex names, the return value will have #' the same structure (but with loops). This behavior corresponds to the #' interpretation of the composition operator as counting walks on labeled sets #' of vertices. #' #' Hypergraphs are not yet supported by these routines, but ultimately will be #' (as suggested by the above). #' #' The specific operations carried out by these operators are generally #' self-explanatory in the non-multiplex case, but semantics in the latter #' circumstance bear elaboration. The following summarizes the behavior of #' each operator: #' \describe{ #' \item{\code{+}}{An \eqn{(i,j)} edge is created in #' the return graph for every \eqn{(i,j)} edge in each of the input graphs.} #' \item{\code{-}}{An \eqn{(i,j)} edge is created in the return graph for #' every \eqn{(i,j)} edge in the first input that is not matched by an #' \eqn{(i,j)} edge in the second input; if the second input has more #' \eqn{(i,j)} edges than the first, no \eqn{(i,j)} edges are created in the #' return graph.} #' \item{\code{*}}{An \eqn{(i,j)} edge is created for every #' pairing of \eqn{(i,j)} edges in the respective input graphs.} #' \item{\code{\%c\%}}{An \eqn{(i,j)} edge is created in the return graph for #' every edge pair \eqn{(i,k),(k,j)} with the first edge in the first input and #' the second edge in the second input.} #' \item{\code{!}}{An \eqn{(i,j)} edge #' is created in the return graph for every \eqn{(i,j)} in the input not having #' an edge.} #' \item{\code{|}}{An \eqn{(i,j)} edge is created in the return #' graph if either input contains an \eqn{(i,j)} edge.} #' \item{\code{&}}{An #' \eqn{(i,j)} edge is created in the return graph if both inputs contain an #' \eqn{(i,j)} edge.} #' } #' Semantics for missing-edge cases follow from the above, #' under the interpretation that edges with \code{na==TRUE} are viewed as #' having an unknown state. Thus, for instance, \code{x*y} with \code{x} #' having 2 \eqn{(i,j)} non-missing and 1 missing edge and \code{y} having 3 #' respective non-missing and 2 missing edges will yield an output network with #' 6 non-missing and 9 missing \eqn{(i,j)} edges. #' #' @rdname network-operators #' @name network.operators #' #' @aliases %c% #' @param e1 an object of class \code{network}. #' @param e2 another \code{network}. #' @return The resulting network. #' @note Currently, there is a naming conflict between the composition operator #' and the \code{\%c\%} operator in the \code{\link[sna]{sna}} package. This #' will be resolved in future releases; for the time being, one can determine #' which version of \code{\%c\%} is in use by varying which package is loaded #' first. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network.extraction}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' #' Wasserman, S. and Faust, K. (1994). \emph{Social Network Analysis: Methods #' and Applications.} Cambridge: University of Cambridge Press. #' @keywords math graphs #' @examples #' #' #Create an in-star #' m<-matrix(0,6,6) #' m[2:6,1]<-1 #' g<-network(m) #' plot(g) #' #' #Compose g with its transpose #' gcgt<-g %c% (network(t(m))) #' plot(gcgt) #' gcgt #' #' #Show the complement of g #' !g #' #' #Perform various arithmatic and logical operations #' (g+gcgt)[,] == (g|gcgt)[,] #All TRUE #' (g-gcgt)[,] == (g&(!(gcgt)))[,] #' (g*gcgt)[,] == (g&gcgt)[,] #' @export "+.network" #' @export "+.network"<-function(e1,e2){ #Set things up outinf<-networkOperatorSetup(x=e1,y=e2) #Select edges to add; semantics are "adding" edges, which is like union #in the non-multigraph case, but actually results in accumulating edge copies #in for multiplex graphs. out<-outinf$net if(is.hyper(out)){ #Hypergraph; for now, return an apology stop("Elementwise operations on hypergraphs not yet supported.") }else{ #Dyadic network out<-outinf$net #For boolean addition, take the union of edge sets el<-rbind(outinf$elx,outinf$ely) elna<-rbind(outinf$elnax,outinf$elnay) if(!is.multiplex(out)){ #If not multiplex, remove duplicates el<-unique(el) elna<-unique(elna) if(NROW(el)>0&&NROW(elna)>0){ n<-network.size(out) elnum<-(el[,1]-1)+n*(el[,2]-1) elnanum<-(elna[,1]-1)+n*(elna[,2]-1) elna<-elna[!(elnanum%in%elnum),,drop=FALSE] #For union, NA loses } } if(NROW(el)>0) #Add non-missing edges add.edges(out,tail=el[,1],head=el[,2]) if(NROW(elna)>0) #Add missing edges add.edges(out,tail=elna[,1],head=elna[,2], names.eval=replicate(NROW(elna),list("na")), vals.eval=replicate(NROW(elna),list(list(na=TRUE)))) } #Return the resulting network out } #"-"<-function(e1, e2, ...) UseMethod("-") # #"-.default"<-function(e1,e2,...) { (base::"-")(e1,e2) } # #' @rdname network-operators #' @export "-.network" #' @export "-.network"<-function(e1,e2){ #Set things up outinf<-networkOperatorSetup(x=e1,y=e2) #Semantics here are "edge subtraction"; this is like "and not" for the #non-multiplex case, but in the latter we can think of it as subtracting #copies of edges (so if there were 5 copies of (i,j) in e1 and 2 copies in #e2, we would be left with 3 copies). Note that this means that NAs are #asymmetric: an edge in e2 will first cancel a "sure" edge, and then an #NA edge when the sure ones are exhausted. NA edges in e2 don't cancel #sure edges in e1, but they render them unsure (i.e., NA). NAs in e2 #have no effect on remaining NAs in e1 (unsure vs unsure), nor on 0s. out<-outinf$net if(is.hyper(out)){ #Hypergraph; for now, return an apology stop("Elementwise operations on hypergraphs not yet supported.") }else{ #Dyadic network out<-outinf$net #For boolean subtraction, want edges in e1 that are not in e2 el<-outinf$elx elna<-outinf$elnax if(!is.multiplex(out)){ #If not multiplex, cancellation is absolute n<-network.size(out) elnum<-(el[,1]-1)+n*(el[,2]-1) elnanum<-(elna[,1]-1)+n*(elna[,2]-1) elynum<-(outinf$ely[,1]-1)+n*(outinf$ely[,2]-1) elynanum<-(outinf$elnay[,1]-1)+n*(outinf$elnay[,2]-1) #For every edge or NA edge in x, kill it if in ely sel<-!(elnum%in%elynum) el<-el[sel,,drop=FALSE] elnum<-elnum[sel] sel<-!(elnanum%in%elynum) elna<-elna[sel,,drop=FALSE] elnanum<-elnanum[sel] #Now, for the remaining edges from x, set to NA if in elyna sel<-!(elnum%in%elynanum) elna<-rbind(elna,el[!sel,,drop=FALSE]) el<-el[sel,,drop=FALSE] #Clean up any non-uniqueness (recall that el, elna started unique) elna<-unique(elna) }else{ #If multiplex, cancellation is 1:1 n<-network.size(out) elnum<-(el[,1]-1)+n*(el[,2]-1) elnanum<-(elna[,1]-1)+n*(elna[,2]-1) elynum<-(outinf$ely[,1]-1)+n*(outinf$ely[,2]-1) elynanum<-(outinf$elnay[,1]-1)+n*(outinf$elnay[,2]-1) #Every edge in ely kills one copy of the corresponding edge in el i<-1 while((NROW(el)>0)&&(i<=length(elynum))){ j<-match(elynum[i],elnum) if(is.na(j)){ #No match; increment i i<-i+1 }else{ #Match! Cancel both and don't increment el<-el[-j,,drop=FALSE] elnum<-elnum[-j] elynum<-elynum[-i] } } #Every remaining ely kills one copy of the corresponding edge in elna i<-1 while((NROW(elna)>0)&&(i<=length(elynum))){ j<-match(elynum[i],elnanum) if(is.na(j)){ #No match; increment i i<-i+1 }else{ #Match! Cancel both and don't increment elna<-elna[-j,,drop=FALSE] elnanum<-elnanum[-j] elynum<-elynum[-i] } } #Every elnay converts one corresponding el to elna i<-1 while((NROW(el)>0)&&(i<=length(elynanum))){ j<-match(elynanum[i],elnum) if(is.na(j)){ #No match; increment i i<-i+1 }else{ #Match! Cancel both and don't increment elna<-rbind(elna,el[j,,drop=FALSE]) el<-el[-j,,drop=FALSE] elnum<-elnum[-j] elynanum<-elynanum[-i] } } } if(NROW(el)>0) #Add non-missing edges add.edges(out,tail=el[,1],head=el[,2]) if(NROW(elna)>0) #Add missing edges add.edges(out,tail=elna[,1],head=elna[,2], names.eval=replicate(NROW(elna),list("na")), vals.eval=replicate(NROW(elna),list(list(na=TRUE)))) } #Return the resulting network out } #"*"<-function(e1, e2, ...) UseMethod("*") # #"*.default"<-function(e1,e2,...) { (base::"*")(e1,e2) } # #' @rdname network-operators #' @export "*.network" #' @export "*.network"<-function(e1,e2){ #Set things up outinf<-networkOperatorSetup(x=e1,y=e2) #Multiplication semantics here are like "and" in the non-multiplex case, #but in the multiplex case we assume that the number of edges is itself #multplied. Multiplication is treated by pairing, so the number of sure #edges is sure(e1)*sure(e2), and the number of NA edges is #sure(e1)*NA(e2) + NA(e1)*sure(e2) + NA(e1)*NA(e2), where sure and NA are #here counts of the (i,j) edge that are non-missing or missing #(respectively). out<-outinf$net if(is.hyper(out)){ #Hypergraph; for now, return an apology stop("Elementwise operations on hypergraphs not yet supported.") }else{ #Dyadic network out<-outinf$net n<-network.size(out) el<-matrix(nrow=0,ncol=2) elna<-matrix(nrow=0,ncol=2) if(is.multiplex(out)){ #Multiplex case: add edge for every pair allpairs<-unique(rbind(outinf$elx,outinf$elnax,outinf$ely,outinf$elnay)) allnum<-(allpairs[,1]-1)+n*(allpairs[,2]-1) elxnum<-(outinf$elx[,1]-1)+n*(outinf$elx[,2]-1) elxnanum<-(outinf$elnax[,1]-1)+n*(outinf$elnax[,2]-1) elynum<-(outinf$ely[,1]-1)+n*(outinf$ely[,2]-1) elynanum<-(outinf$elnay[,1]-1)+n*(outinf$elnay[,2]-1) allxcnt<-sapply(allnum,function(z,w){sum(z==w)},w=elxnum) allxnacnt<-sapply(allnum,function(z,w){sum(z==w)},w=elxnanum) allycnt<-sapply(allnum,function(z,w){sum(z==w)},w=elynum) allynacnt<-sapply(allnum,function(z,w){sum(z==w)},w=elynanum) el<-allpairs[rep(1:length(allnum),times=allxcnt*allycnt),,drop=FALSE] elna<-allpairs[rep(1:length(allnum),times=allxcnt*allynacnt+ allxnacnt*allycnt+allxnacnt*allynacnt),,drop=FALSE] }else{ #Non-multiplex case: "and" elx<-unique(outinf$elx) elnax<-unique(outinf$elnax) ely<-unique(outinf$ely) elnay<-unique(outinf$elnay) elxnum<-(elx[,1]-1)+n*(elx[,2]-1) elxnanum<-(elnax[,1]-1)+n*(elnax[,2]-1) sel<-elxnanum%in%elxnum #Override NA with edges w/in x if(sum(sel)>0){ elnax<-elnax[!sel,,drop=FALSE] elxnanum<-elxnanum[!sel,,drop=FALSE] } elynum<-(ely[,1]-1)+n*(ely[,2]-1) elynanum<-(elnay[,1]-1)+n*(elnay[,2]-1) sel<-elynanum%in%elynum #Override NA with edges w/in y if(sum(sel)>0){ elnay<-elnay[!sel,,drop=FALSE] elynanum<-elynanum[!sel,,drop=FALSE] } #Check for matches across the "sure" edges ematch<-match(elxnum,elynum) el<-rbind(el,elx[!is.na(ematch),,drop=FALSE]) elx<-elx[is.na(ematch),,drop=FALSE] #Remove the matched cases elxnum<-elxnum[is.na(ematch)] if(length(ematch[!is.na(ematch)])>0){ ely<-ely[-ematch[!is.na(ematch)],,drop=FALSE] elynum<-elynum[-ematch[!is.na(ematch)]] } #Match sure xs with unsure ys if(length(elxnum)*length(elynanum)>0){ ematch<-match(elxnum,elynanum) elna<-rbind(elna,elx[!is.na(ematch),,drop=FALSE]) elx<-elx[is.na(ematch),,drop=FALSE] #Remove the matched cases elxnum<-elxnum[is.na(ematch)] if(length(ematch[!is.na(ematch)])>0){ elnay<-elnay[-ematch[!is.na(ematch)],,drop=FALSE] elynanum<-elynanum[-ematch[!is.na(ematch)]] } } #Match sure ys with unsure xs if(length(elynum)*length(elxnanum)>0){ ematch<-match(elynum,elxnanum) elna<-rbind(elna,ely[!is.na(ematch),,drop=FALSE]) ely<-ely[is.na(ematch),,drop=FALSE] #Remove the matched cases elynum<-elynum[is.na(ematch)] if(length(ematch[!is.na(ematch)])>0){ elnax<-elnax[-ematch[!is.na(ematch)],,drop=FALSE] elxnanum<-elxnanum[-ematch[!is.na(ematch)]] } } #Match unsure xs with unsure ys if(length(elxnanum)*length(elynanum)>0){ ematch<-match(elxnanum,elynanum) elna<-rbind(elna,elnax[!is.na(ematch),,drop=FALSE]) } } if(NROW(el)>0) #Add non-missing edges add.edges(out,tail=el[,1],head=el[,2]) if(NROW(elna)>0) #Add missing edges add.edges(out,tail=elna[,1],head=elna[,2], names.eval=replicate(NROW(elna),list("na")), vals.eval=replicate(NROW(elna),list(list(na=TRUE)))) } #Return the resulting network out } #' @rdname network-operators #' @export "!.network" #' @export "!.network"<-function(e1){ #Set things up outinf<-networkOperatorSetup(x=e1) #Select edges to add; semantics are "not" which means that one takes the #non-multiplex complement of edges. Any sure edge implies 0, an NA edge #without a sure edge implies NA, no sure or NA edge implies 1. out<-outinf$net if(is.hyper(out)){ #Hypergraph; for now, return an apology stop("Elementwise operations on hypergraphs not yet supported.") }else{ #Dyadic network out<-outinf$net n<-network.size(out) #Start with the complete graph, and cut things away el<-cbind(rep(1:n,each=n),rep(1:n,n)) if(!is.directed(out)) #Needs to match order in networkOperatorSetup el<-el[el[,1]<=el[,2],] if(!has.loops(out)) el<-el[el[,1]!=el[,2],] elnum<-(el[,1]-1)+n*(el[,2]-1) elna<-matrix(nrow=0,ncol=2) #Remove all sure edges elx<-unique(outinf$elx) elxnum<-(elx[,1]-1)+n*(elx[,2]-1) ematch<-match(elxnum,elnum) if(length(ematch[!is.na(ematch)])>0){ el<-el[-ematch[!is.na(ematch)],,drop=FALSE] elnum<-elnum[-ematch[!is.na(ematch)]] } #Convert all unsure edges to NAs elnax<-unique(outinf$elnax) elxnanum<-(elnax[,1]-1)+n*(elnax[,2]-1) ematch<-match(elxnanum,elnum) if(length(ematch[!is.na(ematch)])>0){ elna<-el[ematch[!is.na(ematch)],,drop=FALSE] el<-el[-ematch[!is.na(ematch)],,drop=FALSE] } if(NROW(el)>0) #Add non-missing edges add.edges(out,tail=el[,1],head=el[,2]) if(NROW(elna)>0) #Add missing edges add.edges(out,tail=elna[,1],head=elna[,2], names.eval=replicate(NROW(elna),list("na")), vals.eval=replicate(NROW(elna),list(list(na=TRUE)))) } #Return the resulting network out } #' @rdname network-operators #' @export "|.network" #' @export "|.network"<-function(e1,e2){ #Set things up outinf<-networkOperatorSetup(x=e1,y=e2) #Select edges to add; semantics are "or," which means that one takes the #non-multiplex union of edges (like the non-multiplex case of the + #operator). Here, a sure edge in either input graph will override an NA, #and an NA will override a zero. out<-outinf$net if(is.hyper(out)){ #Hypergraph; for now, return an apology stop("Elementwise operations on hypergraphs not yet supported.") }else{ #Dyadic network out<-outinf$net #For boolean addition, take the union of edge sets el<-rbind(outinf$elx,outinf$ely) elna<-rbind(outinf$elnax,outinf$elnay) el<-unique(el) elna<-unique(elna) if(NROW(el)>0&&NROW(elna)>0){ n<-network.size(out) elnum<-(el[,1]-1)+n*(el[,2]-1) elnanum<-(elna[,1]-1)+n*(elna[,2]-1) elna<-elna[!(elnanum%in%elnum),,drop=FALSE] #For union, NA loses } if(NROW(el)>0) #Add non-missing edges add.edges(out,tail=el[,1],head=el[,2]) if(NROW(elna)>0) #Add missing edges add.edges(out,tail=elna[,1],head=elna[,2], names.eval=replicate(NROW(elna),list("na")), vals.eval=replicate(NROW(elna),list(list(na=TRUE)))) } #Return the resulting network out } #' @rdname network-operators #' @export "&.network" #' @export "&.network"<-function(e1,e2){ #Set things up outinf<-networkOperatorSetup(x=e1,y=e2) #Select edges to add; semantics are "and," which means that one places an #(i,j) edge if there exists a sure (i,j) edge in both e1 and e2. If there #is not a sure edge in each but there is at least an unsure edge in each, #then we place an NA in the (i,j) slot. Otherwise, we leave it empty. This #is just like boolean "and" for non-multiplex graphs, but is not quite the #same in the multiplex case. out<-outinf$net if(is.hyper(out)){ #Hypergraph; for now, return an apology stop("Elementwise operations on hypergraphs not yet supported.") }else{ #Dyadic network out<-outinf$net n<-network.size(out) el<-matrix(nrow=0,ncol=2) elna<-matrix(nrow=0,ncol=2) elx<-unique(outinf$elx) elnax<-unique(outinf$elnax) ely<-unique(outinf$ely) elnay<-unique(outinf$elnay) elxnum<-(elx[,1]-1)+n*(elx[,2]-1) elxnanum<-(elnax[,1]-1)+n*(elnax[,2]-1) sel<-elxnanum%in%elxnum #Override NA with edges w/in x if(sum(sel)>0){ elnax<-elnax[!sel,,drop=FALSE] elxnanum<-elxnanum[!sel,,drop=FALSE] } elynum<-(ely[,1]-1)+n*(ely[,2]-1) elynanum<-(elnay[,1]-1)+n*(elnay[,2]-1) sel<-elynanum%in%elynum #Override NA with edges w/in y if(sum(sel)>0){ elnay<-elnay[!sel,,drop=FALSE] elynanum<-elynanum[!sel,,drop=FALSE] } #Check for matches across the "sure" edges ematch<-match(elxnum,elynum) el<-rbind(el,elx[!is.na(ematch),,drop=FALSE]) elx<-elx[is.na(ematch),,drop=FALSE] #Remove the matched cases elxnum<-elxnum[is.na(ematch)] if(length(ematch[!is.na(ematch)])>0){ ely<-ely[-ematch[!is.na(ematch)],,drop=FALSE] elynum<-elynum[-ematch[!is.na(ematch)]] } #Match sure xs with unsure ys if(length(elxnum)*length(elynanum)>0){ ematch<-match(elxnum,elynanum) elna<-rbind(elna,elx[!is.na(ematch),,drop=FALSE]) elx<-elx[is.na(ematch),,drop=FALSE] #Remove the matched cases elxnum<-elxnum[is.na(ematch)] if(length(ematch[!is.na(ematch)])>0){ elnay<-elnay[-ematch[!is.na(ematch)],,drop=FALSE] elynanum<-elynanum[-ematch[!is.na(ematch)]] } } #Match sure ys with unsure xs if(length(elynum)*length(elxnanum)>0){ ematch<-match(elynum,elxnanum) elna<-rbind(elna,ely[!is.na(ematch),,drop=FALSE]) ely<-ely[is.na(ematch),,drop=FALSE] #Remove the matched cases elynum<-elynum[is.na(ematch)] if(length(ematch[!is.na(ematch)])>0){ elnax<-elnax[-ematch[!is.na(ematch)],,drop=FALSE] elxnanum<-elxnanum[-ematch[!is.na(ematch)]] } } #Match unsure xs with unsure ys if(length(elxnanum)*length(elynanum)>0){ ematch<-match(elxnanum,elynanum) elna<-rbind(elna,elnax[!is.na(ematch),,drop=FALSE]) } if(NROW(el)>0) #Add non-missing edges add.edges(out,tail=el[,1],head=el[,2]) if(NROW(elna)>0) #Add missing edges add.edges(out,tail=elna[,1],head=elna[,2], names.eval=replicate(NROW(elna),list("na")), vals.eval=replicate(NROW(elna),list(list(na=TRUE)))) } #Return the resulting network out } # --------------------------- %c% ------------------------------- # conditionally create this method, as it may allready have # been created and loaded by sna package if (!exists('%c%')){ #' @export "%c%" "%c%"<-function(e1,e2){ UseMethod("%c%",e1) } } #' @rdname network-operators #' @export "%c%.network" #' @export "%c%.network"<-function(e1,e2){ #Set things up net1<-networkOperatorSetup(x=e1) net2<-networkOperatorSetup(x=e2) if(is.bipartite(net1$net)){ #Find in/out set sizes for e1 insz1<-net1$net%n%"bipartite" outsz1<-net1$net%n%"n"-net1$net%n%"bipartite" }else{ insz1<-net1$net%n%"n" outsz1<-net1$net%n%"n" } if(is.bipartite(net2$net)){ #Find in/out set sizes for e2 insz2<-net2$net%n%"bipartite" outsz2<-net2$net%n%"n"-net2$net%n%"bipartite" }else{ insz2<-net2$net%n%"n" outsz2<-net2$net%n%"n" } if(outsz1!=insz2) stop("Non-conformable relations in %c%. Cannot compose.") if(is.hyper(net1$net)||is.hyper(net2$net)) #Hypergraph; for now, stop stop("Elementwise operations on hypergraphs not yet supported.") #Test for vertex name matching (governs whether we treat as bipartite) if(is.network(e1)) vnam1<-network.vertex.names(e1) else if(!is.null(attr(e1,"vnames"))) vnam1<-attr(e1,"vnames") else if(is.matrix(e1)||is.data.frame(e1)||is.array(e1)) vnam1<-row.names(e1) else vnam1<-NULL if(is.network(e2)) vnam2<-network.vertex.names(e2) else if(!is.null(attr(e2,"vnames"))) vnam2<-attr(e2,"vnames") else if(is.matrix(e2)||is.data.frame(e2)||is.array(e2)) vnam2<-row.names(e2) else vnam2<-NULL if((!is.null(vnam1))&&(!is.null(vnam2))&&(length(vnam1)==length(vnam2)) &&all(vnam1==vnam2)) vnammatch<-TRUE else vnammatch<-FALSE #Decide on bipartite representation and create graph if((!is.bipartite(net1$net))&&(!is.bipartite(net2$net))&&vnammatch) out<-network.initialize(insz1, directed=is.directed(net1$net)|is.directed(net2$net), loops=TRUE,multiple=is.multiplex(net1$net)|is.multiplex(net2$net)) else out<-network.initialize(insz1+outsz2,bipartite=insz1, directed=is.directed(net1$net)|is.directed(net2$net),multiple=is.multiplex(net1$net)|is.multiplex(net2$net)) #Accumulate edges (yeah, could be made more efficient -- cope with it) el<-matrix(nrow=0,ncol=2) elna<-matrix(nrow=0,ncol=2) bip1<-net1$net%n%"bipartite" bip2<-net2$net%n%"bipartite" if(!is.directed(net1$net)){ #Double the edges if undirected net1$elx<-rbind(net1$elx,net1$elx[net1$elx[,1]!=net1$elx[,2],2:1]) net1$elnax<-rbind(net1$elnax,net1$elnax[net1$elnax[,1]!=net1$elnax[,2],2:1]) } if(!is.directed(net2$net)){ #Double the edges if undirected net2$elx<-rbind(net2$elx,net2$elx[net2$elx[,1]!=net2$elx[,2],2:1]) net2$elnax<-rbind(net2$elnax,net2$elnax[net2$elnax[,1]!=net2$elnax[,2],2:1]) } if(NROW(net1$elx)>0){ for(i in 1:NROW(net1$elx)){ sel<-net2$elx[net2$elx[,1]==(net1$elx[i,2]-bip1),2]-bip2 if(length(sel)>0) el<-rbind(el,cbind(rep(net1$elx[i,1],length(sel)),sel+insz1)) } } if(NROW(net1$elnax)>0){ for(i in 1:NROW(net1$elnax)){ sel<-net2$elnax[net2$elnax[,1]==(net1$elnax[i,2]-bip1),2]-bip2 if(length(sel)>0) elna<-rbind(elna,cbind(rep(net1$elnax[i,1],length(sel)),sel+insz1)) } } if(!is.bipartite(out)){ #If not bipartite, remove the insz1 offset if(NROW(el)>0) el[,2]<-el[,2]-insz1 if(NROW(elna)>0) elna[,2]<-elna[,2]-insz1 } if(!is.multiplex(out)){ #If necessary, consolidate edges if(NROW(el)>1) el<-unique(el) if(NROW(elna)>1){ elna<-unique(elna) } if(NROW(elna)>0&&NROW(el)>0){ sel<-rep(TRUE,NROW(elna)) for(i in 1:NROW(elna)){ if(any((el[,1]==elna[i,1])&(el[,2]==elna[i,2]))) sel[i]<-FALSE } elna<-elna[sel,] } } #Add the edges if(NROW(el)>0) #Add non-missing edges add.edges(out,tail=el[,1],head=el[,2]) if(NROW(elna)>0) #Add missing edges add.edges(out,tail=elna[,1],head=elna[,2], names.eval=replicate(NROW(elna),list("na")), vals.eval=replicate(NROW(elna),list(list(na=TRUE)))) #Return the resulting network out } #Given one or two input networks, return the information needed to generate #output for binary or unary operations. The return value for this function is #a list with elements: # net: the output network (empty, but with attributes set) # elx: the edgelist for the first network (non-missing) # elnax: the list of missing edges for the first network # ely: in the binary case, the edgelist for the second network (non-missing) # elnay: in the binary case, the list of missing edges for the second network #' @rdname network-internal networkOperatorSetup<-function(x,y=NULL){ #Determine what attributes the output should have if(is.network(x)){ nx<-network.size(x) #Get size, directedness, multiplexity, bipartition dx<-is.directed(x) mx<-is.multiplex(x) hx<-is.hyper(x) lx<-has.loops(x) bx<-x%n%"bipartite" if(is.null(bx)) bx<-FALSE }else{ #If not a network object, resort to adj form x<-as.sociomatrix(x) if(NROW(x)!=NCOL(x)){ #Bipartite matrix nx<-NROW(x)+NCOL(x) dx<-FALSE mx<-FALSE hx<-FALSE lx<-FALSE bx<-NROW(x) }else{ nx<-NROW(x) dx<-TRUE mx<-FALSE hx<-FALSE lx<-any(diag(x)!=0,na.rm=TRUE) bx<-FALSE } } if(is.null(y)){ #If y is null, setup for unary operator n<-nx d<-dx m<-mx h<-hx b<-bx l<-lx x<-x }else{ #Binary case if(is.network(y)){ ny<-network.size(y) #Get size, directedness, multiplexity, bipartition dy<-is.directed(y) my<-is.multiplex(y) hy<-is.hyper(y) ly<-has.loops(y) by<-y%n%"bipartite" if(is.null(by)) by<-FALSE }else{ #If not a network object, resort to adj form y<-as.sociomatrix(y) if(NROW(y)!=NCOL(y)){ #Bipartite matrix ny<-NROW(y)+NCOL(y) dy<-FALSE my<-FALSE hy<-FALSE ly<-FALSE by<-NROW(y) }else{ ny<-NROW(y) dy<-TRUE my<-FALSE hy<-FALSE ly<-any(diag(y)!=0,na.rm=TRUE) by<-FALSE } } if(nx!=ny) #Make sure that our networks are conformable stop("Non-conformable networks (must have same numbers of vertices for elementwise operations).") if(bx!=by) stop("Non-conformable networks (must have same bipartite status for elementwise operations).") n<-nx #Output size=input size b<-bx #Output bipartition=input bipartition d<-dx|dy #Output directed if either input directed l<-lx|ly #Output has loops if either input does h<-hx|hy #Output hypergraphic if either input is m<-mx|my #Output multiplex if either input is } #Create the empty network object that will ultimately receive the edges net<-network.initialize(n=n,directed=d,hyper=h,loops=l,multiple=m,bipartite=b) #Create the edge lists; what the operator does with 'em isn't our problem if(h){ #Hypergraph stop("Elementwise operations not yet supported on hypergraphs.") }else{ #Dyadic network #Get the raw edge information if(is.network(x)){ elx<-as.matrix(x,matrix.type="edgelist") elnax<-as.matrix(is.na(x),matrix.type="edgelist") if(d&(!dx)){ #Need to add two-way edges; BTW, can't have (!d)&dx... elx<-rbind(elx,elx[elx[,2]!=elx[,1],2:1,drop=FALSE]) elnax<-rbind(elnax,elnax[,2:1]) } else if (!dx){ # need to enforce edge ordering ielx[,2],]<-elx[elx[,1]>elx[,2],c(2,1)] } }else{ elx<-which(x!=0,arr.ind=TRUE) elnax<-which(is.na(x),arr.ind=TRUE) if(!d){ #Sociomatrix already has two-way edges, so might need to remove elx<-elx[elx[,1]>=elx[,2],,drop=FALSE] elnax<-elnax[elnax[,1]>=elnax[,2],,drop=FALSE] } } if(!is.null(y)){ if(is.network(y)){ ely<-as.matrix(y,matrix.type="edgelist") elnay<-as.matrix(is.na(y),matrix.type="edgelist") if(d&(!dy)){ #Need to add two-way edges; BTW, can't have (!d)&dy... ely<-rbind(ely,ely[ely[,2]!=ely[,1],2:1,drop=FALSE]) elnay<-rbind(elnay,elnay[,2:1]) } else if (!dy){ # need to enforce edge ordering iely[,2],]<-ely[ely[,1]>ely[,2],c(2,1)] } }else{ ely<-which(y!=0,arr.ind=TRUE) elnay<-which(is.na(y),arr.ind=TRUE) if(!d){ #Sociomatrix already has two-way edges, so might need to remove ely<-ely[ely[,1]>=ely[,2],,drop=FALSE] elnay<-elnay[elnay[,1]>=elnay[,2],d,rop=FALSE] } } } if(!l){ #Pre-emptively remove loops, as needed elx<-elx[elx[,1]!=elx[,2],,drop=FALSE] elnax<-elnax[elnax[,1]!=elnax[,2],,drop=FALSE] if(!is.null(y)){ ely<-ely[ely[,1]!=ely[,2],,drop=FALSE] elnay<-elnay[elnay[,1]!=elnay[,2],,drop=FALSE] } } if(!m){ #Pre-emptively remove multiplex edges, as needed elx<-unique(elx) elnax<-unique(elnax) if(!is.null(y)){ ely<-unique(ely) elnay<-unique(elnay) } } } #Return everything if(is.null(y)) list(net=net,elx=elx,elnax=elnax) else list(net=net,elx=elx,elnax=elnax,ely=ely,elnay=elnay) } #' Combine Networks by Edge Value Multiplication #' #' Given a series of networks, \code{prod.network} attempts to form a new #' network by multiplication of edges. If a non-null \code{attrname} is given, #' the corresponding edge attribute is used to determine and store edge values. #' #' The network product method attempts to combine its arguments by edgewise #' multiplication (\emph{not} composition) of their respective adjacency #' matrices; thus, this method is only applicable for networks whose adjacency #' coercion is well-behaved. Multiplication is effectively boolean unless #' \code{attrname} is specified, in which case this is used to assess edge #' values -- net values of 0 will result in removal of the underlying edge. #' #' Other network attributes in the return value are carried over from the first #' element in the list, so some persistence is possible (unlike the #' multiplication operator). Note that it is sometimes possible to #' \dQuote{multiply} networks and raw adjacency matrices using this routine (if #' all dimensions are correct), but more exotic combinations may result in #' regrettably exciting behavior. #' #' @param \dots one or more \code{network} objects. #' @param attrname the name of an edge attribute to use when assessing edge #' values, if desired. #' @param na.rm logical; should edges with missing data be ignored? #' @return A \code{\link{network}} object. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network.operators}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @keywords arith graphs #' @examples #' #' #Create some networks #' g<-network.initialize(5) #' h<-network.initialize(5) #' i<-network.initialize(5) #' g[1:3,,names.eval="marsupial",add.edges=TRUE]<-1 #' h[1:2,,names.eval="marsupial",add.edges=TRUE]<-2 #' i[1,,names.eval="marsupial",add.edges=TRUE]<-3 #' #' #Combine by addition #' pouch<-prod(g,h,i,attrname="marsupial") #' pouch[,] #Edge values in the pouch? #' as.sociomatrix(pouch,attrname="marsupial") #Recover the marsupial #' #' @export prod.network #' @export prod.network<-function(..., attrname=NULL, na.rm=FALSE){ inargs<-list(...) y<-inargs[[1]] for(i in (1:length(inargs))[-1]){ x<-as.sociomatrix(inargs[[i]],attrname=attrname) if(na.rm) x[is.na(x)]<-0 ym<-as.sociomatrix(y,attrname=attrname) if(na.rm) ym[is.na(ym)]<-0 y[,,names.eval=attrname,add.edges=TRUE]<-x*ym } y } #' Combine Networks by Edge Value Addition #' #' Given a series of networks, \code{sum.network} attempts to form a new #' network by accumulation of edges. If a non-null \code{attrname} is given, #' the corresponding edge attribute is used to determine and store edge values. #' #' The network summation method attempts to combine its arguments by addition #' of their respective adjacency matrices; thus, this method is only applicable #' for networks whose adjacency coercion is well-behaved. Addition is #' effectively boolean unless \code{attrname} is specified, in which case this #' is used to assess edge values -- net values of 0 will result in removal of #' the underlying edge. #' #' Other network attributes in the return value are carried over from the first #' element in the list, so some persistence is possible (unlike the addition #' operator). Note that it is sometimes possible to \dQuote{add} networks and #' raw adjacency matrices using this routine (if all dimensions are correct), #' but more exotic combinations may result in regrettably exciting behavior. #' #' @param \dots one or more \code{network} objects. #' @param attrname the name of an edge attribute to use when assessing edge #' values, if desired. #' @param na.rm logical; should edges with missing data be ignored? #' @return A \code{\link{network}} object. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network.operators}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @keywords arith graphs #' @examples #' #' #Create some networks #' g<-network.initialize(5) #' h<-network.initialize(5) #' i<-network.initialize(5) #' g[1,,names.eval="marsupial",add.edges=TRUE]<-1 #' h[1:2,,names.eval="marsupial",add.edges=TRUE]<-2 #' i[1:3,,names.eval="marsupial",add.edges=TRUE]<-3 #' #' #Combine by addition #' pouch<-sum(g,h,i,attrname="marsupial") #' pouch[,] #Edge values in the pouch? #' as.sociomatrix(pouch,attrname="marsupial") #Recover the marsupial #' #' @export sum.network #' @export sum.network<-function(..., attrname=NULL, na.rm=FALSE){ inargs<-list(...) y<-inargs[[1]] for(i in (1:length(inargs))[-1]){ x<-as.sociomatrix(inargs[[i]],attrname=attrname) if(na.rm) x[is.na(x)]<-0 ym<-as.sociomatrix(y,attrname=attrname) if(na.rm) ym[is.na(ym)]<-0 y[,,names.eval=attrname,add.edges=TRUE]<-x+ym } y } network/R/plot.R0000644000176200001440000017354314057075374013276 0ustar liggesusers###################################################################### # # plot.R # # Written by Carter T. Butts ; portions contributed by # David Hunter and Mark S. Handcock # . # # Last Modified 06/06/21 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains various routines related to network visualization. # # Contents: # # network.arrow # network.loop # network.vertex # plot.network # plot.network.default # ###################################################################### #Introduce a function to make coordinates for a single polygon make.arrow.poly.coords<-function(x0,y0,x1,y1,ahangle,ahlen,swid,toff,hoff,ahead, curve,csteps){ slen<-sqrt((x0-x1)^2+(y0-y1)^2) #Find the total length if(curve==0){ #Straight edges if(ahead){ coord<-rbind( #Produce a "generic" version w/head c(-swid/2,toff), c(-swid/2,slen-0.5*ahlen-hoff), c(-ahlen*sin(ahangle),slen-ahlen*cos(ahangle)-hoff), c(0,slen-hoff), c(ahlen*sin(ahangle),slen-ahlen*cos(ahangle)-hoff), c(swid/2,slen-0.5*ahlen-hoff), c(swid/2,toff), c(NA,NA) ) }else{ coord<-rbind( #Produce a "generic" version w/out head c(-swid/2,toff), c(-swid/2,slen-hoff), c(swid/2,slen-hoff), c(swid/2,toff), c(NA,NA) ) } }else{ #Curved edges if(ahead){ inc<-(0:csteps)/csteps coord<-rbind( cbind(-curve*(1-(2*(inc-0.5))^2)-swid/2-sqrt(2)/2*(toff+inc*(hoff-toff)), inc*(slen-sqrt(2)/2*(hoff+toff)-ahlen*0.5)+sqrt(2)/2*toff), c(ahlen*sin(-ahangle-pi/16)-sqrt(2)/2*hoff, slen-ahlen*cos(-ahangle-pi/16)-sqrt(2)/2*hoff), c(-sqrt(2)/2*hoff,slen-sqrt(2)/2*hoff), c(ahlen*sin(ahangle-pi/16)-sqrt(2)/2*hoff, slen-ahlen*cos(ahangle-pi/16)-sqrt(2)/2*hoff), cbind(-curve*(1-(2*(rev(inc)-0.5))^2)+swid/2-sqrt(2)/2*(toff+rev(inc)*(hoff-toff)), rev(inc)*(slen-sqrt(2)/2*(hoff+toff)-ahlen*0.5)+sqrt(2)/2*toff), c(NA,NA) ) }else{ inc<-(0:csteps)/csteps coord<-rbind( cbind(-curve*(1-(2*(inc-0.5))^2)-swid/2-sqrt(2)/2*(toff+inc*(hoff-toff)), inc*(slen-sqrt(2)/2*(hoff+toff))+sqrt(2)/2*toff), cbind(-curve*(1-(2*(rev(inc)-0.5))^2)+swid/2-sqrt(2)/2*(toff+rev(inc)*(hoff-toff)), rev(inc)*(slen-sqrt(2)/2*(hoff+toff))+sqrt(2)/2*toff), c(NA,NA) ) } } theta<-atan2(y1-y0,x1-x0)-pi/2 #Rotate about origin rmat<-rbind(c(cos(theta),sin(theta)),c(-sin(theta),cos(theta))) coord<-coord%*%rmat coord[,1]<-coord[,1]+x0 #Translate to (x0,y0) coord[,2]<-coord[,2]+y0 coord } #Custom arrow-drawing method for plot.network #' Add Arrows or Segments to a Plot #' #' \code{network.arrow} draws a segment or arrow between two pairs of points; #' unlike \code{\link{arrows}} or \code{\link{segments}}, the new plot element #' is drawn as a polygon. #' #' \code{network.arrow} provides a useful extension of \code{\link{segments}} #' and \code{\link{arrows}} when fine control is needed over the resulting #' display. (The results also look better.) Note that edge curvature is #' quadratic, with \code{curve} providing the maximum horizontal deviation of #' the edge (left-handed). Head/tail offsets are used to adjust the end/start #' points of an edge, relative to the baseline coordinates; these are useful #' for functions like \code{\link{plot.network}}, which need to draw edges #' incident to vertices of varying radii. #' #' @param x0 A vector of x coordinates for points of origin #' @param y0 A vector of y coordinates for points of origin #' @param x1 A vector of x coordinates for destination points #' @param y1 A vector of y coordinates for destination points #' @param length Arrowhead length, in current plotting units #' @param angle Arrowhead angle (in degrees) #' @param width Width for arrow body, in current plotting units (can be a #' vector) #' @param col Arrow body color (can be a vector) #' @param border Arrow border color (can be a vector) #' @param lty Arrow border line type (can be a vector) #' @param offset.head Offset for destination point (can be a vector) #' @param offset.tail Offset for origin point (can be a vector) #' @param arrowhead Boolean; should arrowheads be used? (Can be a vector)) #' @param curve Degree of edge curvature (if any), in current plotting units #' (can be a vector) #' @param edge.steps For curved edges, the number of steps to use in #' approximating the curve (can be a vector) #' @param \dots Additional arguments to \code{\link{polygon}} #' @return None. #' @note \code{network.arrow} is a direct adaptation of #' \code{\link[sna]{gplot.arrow}} from the \code{sna} package. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{plot.network}}, \code{\link{network.loop}}, #' \code{\link{polygon}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @keywords aplot graphs #' @examples #' #' #Plot two points #' plot(1:2,1:2) #' #' #Add an edge #' network.arrow(1,1,2,2,width=0.01,col="red",border="black") #' #' @export network.arrow network.arrow<-function(x0,y0,x1,y1,length=0.1,angle=20,width=0.01,col=1,border=1,lty=1,offset.head=0,offset.tail=0,arrowhead=TRUE,curve=0,edge.steps=50,...){ if(length(x0)==0) #Leave if there's nothing to do return() #"Stretch" the arguments n<-length(x0) angle<-rep(angle,length=n)/360*2*pi length<-rep(length,length=n) width<-rep(width,length=n) col<-rep(col,length=n) border<-rep(border,length=n) lty<-rep(lty,length=n) arrowhead<-rep(arrowhead,length=n) offset.head<-rep(offset.head,length=n) offset.tail<-rep(offset.tail,length=n) curve<-rep(curve,length=n) edge.steps<-rep(edge.steps,length=n) #Obtain coordinates coord<-vector() for(i in 1:n) coord<-rbind(coord,make.arrow.poly.coords(x0[i],y0[i],x1[i],y1[i],angle[i],length[i], width[i],offset.tail[i],offset.head[i],arrowhead[i],curve[i],edge.steps[i])) coord<-coord[-NROW(coord),] #Draw polygons. # the coord matrix has some NA rows, which will break it into multiple polygons polygon(coord,col=col,border=border,lty=lty,...) } #Introduce a function to make coordinates for a single polygon make.loop.poly.coords<-function(x0,y0,xctr,yctr,ahangle,ahlen,swid,off,rad,ahead,edge.steps){ #Determine the center of the plot xoff <- x0-xctr yoff <- y0-yctr roff <- sqrt(xoff^2+yoff^2) x0hat <- xoff/roff y0hat <- yoff/roff r0.vertex <- off r0.loop <- rad x0.loop <- x0hat*r0.loop y0.loop <- y0hat*r0.loop ang <- (((0:edge.steps)/edge.steps)*(1-(2*r0.vertex+0.5*ahlen*ahead)/ (2*pi*r0.loop))+r0.vertex/(2*pi*r0.loop))*2*pi+atan2(-yoff,-xoff) ang2 <- ((1-(2*r0.vertex)/(2*pi*r0.loop))+r0.vertex/(2*pi*r0.loop))*2*pi+ atan2(-yoff,-xoff) if(ahead){ x0.arrow <- x0.loop+(r0.loop+swid/2)*cos(ang2) y0.arrow <- y0.loop+(r0.loop+swid/2)*sin(ang2) coord<-rbind( cbind(x0.loop+(r0.loop+swid/2)*cos(ang), y0.loop+(r0.loop+swid/2)*sin(ang)), cbind(x0.arrow+ahlen*cos(ang2-pi/2), y0.arrow+ahlen*sin(ang2-pi/2)), cbind(x0.arrow,y0.arrow), cbind(x0.arrow+ahlen*cos(-2*ahangle+ang2-pi/2), y0.arrow+ahlen*sin(-2*ahangle+ang2-pi/2)), cbind(x0.loop+(r0.loop-swid/2)*cos(rev(ang)), y0.loop+(r0.loop-swid/2)*sin(rev(ang))), c(NA,NA) ) }else{ coord<-rbind( cbind(x0.loop+(r0.loop+swid/2)*cos(ang), y0.loop+(r0.loop+swid/2)*sin(ang)), cbind(x0.loop+(r0.loop-swid/2)*cos(rev(ang)), y0.loop+(r0.loop-swid/2)*sin(rev(ang))), c(NA,NA) ) } coord[,1]<-coord[,1]+x0 #Translate to (x0,y0) coord[,2]<-coord[,2]+y0 coord } #Custom loop-drawing method for plot.network #' Add Loops to a Plot #' #' \code{network.loop} draws a "loop" at a specified location; this is used to #' designate self-ties in \code{\link{plot.network}}. #' #' \code{network.loop} is the companion to \code{\link{network.arrow}}; like #' the latter, plot elements produced by \code{network.loop} are drawn using #' \code{\link{polygon}}, and as such are scaled based on the current plotting #' device. By default, loops are drawn so as to encompass a circular region of #' radius \code{radius}, whose center is \code{offset} units from \code{x0,y0} #' and at maximum distance from \code{xctr,yctr}. This is useful for functions #' like \code{\link{plot.network}}, which need to draw loops incident to #' vertices of varying radii. #' #' @param x0 a vector of x coordinates for points of origin. #' @param y0 a vector of y coordinates for points of origin. #' @param length arrowhead length, in current plotting units. #' @param angle arrowhead angle (in degrees). #' @param width width for loop body, in current plotting units (can be a #' vector). #' @param col loop body color (can be a vector). #' @param border loop border color (can be a vector). #' @param lty loop border line type (can be a vector). #' @param offset offset for origin point (can be a vector). #' @param edge.steps number of steps to use in approximating curves. #' @param radius loop radius (can be a vector). #' @param arrowhead boolean; should arrowheads be used? (Can be a vector.) #' @param xctr x coordinate for the central location away from which loops #' should be oriented. #' @param yctr y coordinate for the central location away from which loops #' should be oriented. #' @param \dots additional arguments to \code{\link{polygon}}. #' @return None. #' @note \code{network.loop} is a direct adaptation of #' \code{\link[sna]{gplot.loop}}, from the \code{sna} package. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network.arrow}}, \code{\link{plot.network}}, #' \code{\link{polygon}} #' @keywords aplot graphs #' @examples #' #' #Plot a few polygons with loops #' plot(0,0,type="n",xlim=c(-2,2),ylim=c(-2,2),asp=1) #' network.loop(c(0,0),c(1,-1),col=c(3,2),width=0.05,length=0.4, #' offset=sqrt(2)/4,angle=20,radius=0.5,edge.steps=50,arrowhead=TRUE) #' polygon(c(0.25,-0.25,-0.25,0.25,NA,0.25,-0.25,-0.25,0.25), #' c(1.25,1.25,0.75,0.75,NA,-1.25,-1.25,-0.75,-0.75),col=c(2,3)) #' #' #' @export network.loop network.loop<-function(x0,y0,length=0.1,angle=10,width=0.01,col=1,border=1,lty=1,offset=0,edge.steps=10,radius=1,arrowhead=TRUE,xctr=0,yctr=0,...){ if(length(x0)==0) #Leave if there's nothing to do return() #"Stretch" the arguments n<-length(x0) angle<-rep(angle,length=n)/360*2*pi length<-rep(length,length=n) width<-rep(width,length=n) col<-rep(col,length=n) border<-rep(border,length=n) lty<-rep(lty,length=n) rad<-rep(radius,length=n) arrowhead<-rep(arrowhead,length=n) offset<-rep(offset,length=n) #Obtain coordinates coord<-vector() for(i in 1:n) coord<-rbind(coord,make.loop.poly.coords(x0[i],y0[i],xctr,yctr,angle[i],length[i], width[i],offset[i],rad[i],arrowhead[i],edge.steps)) coord<-coord[-NROW(coord),] #Draw polygons polygon(coord,col=col,border=border,lty=lty,...) } #Introduce a function to make coordinates for a single vertex polygon # this version just uses the raw radius, so triangles appear half the size of circles old.make.vertex.poly.coords<-function(x,y,r,s,rot){ ang<-(1:s)/s*2*pi+rot*2*pi/360 rbind(cbind(x+r*cos(ang),y+r*sin(ang)),c(NA,NA)) } #Introduce a function to make coordinates for a single vertex polygon # all polygons produced will have equal area make.vertex.poly.coords<-function(x,y,r,s,rot){ # trap some edge cases if(is.na(s) || s<2){ return(rbind(c(x,y),c(NA,NA))) # return a single point } else { #scale r (circumradius) to make area equal area<-pi*r^2 # target area based desired r as radius of circle # solve for new r as polygon radius that would match the area of the circle r<-sqrt(2*area / (s*sin(2*pi/s))) ang<-(1:s)/s*2*pi+rot*2*pi/360 return(rbind(cbind(x+r*cos(ang),y+r*sin(ang)),c(NA,NA))) } } #Routine to plot vertices, using polygons #' Add Vertices to a Plot #' #' \code{network.vertex} adds one or more vertices (drawn using #' \code{\link{polygon}}) to a plot. #' #' \code{network.vertex} draws regular polygons of specified radius and number #' of sides, at the given coordinates. This is useful for routines such as #' \code{\link{plot.network}}, which use such shapes to depict vertices. #' #' @param x a vector of x coordinates. #' @param y a vector of y coordinates. #' @param radius a vector of vertex radii. #' @param sides a vector containing the number of sides to draw for each #' vertex. #' @param border a vector of vertex border colors. #' @param col a vector of vertex interior colors. #' @param lty a vector of vertex border line types. #' @param rot a vector of vertex rotation angles (in degrees). #' @param lwd a vector of vertex border line widths. #' @param \dots Additional arguments to \code{\link{polygon}} #' @return None #' @note \code{network.vertex} is a direct adaptation of #' \code{\link[sna]{gplot.vertex}} from the \code{sna} package. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{plot.network}}, \code{\link{polygon}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' @keywords aplot graphs #' @examples #' #' #' #Open a plot window, and place some vertices #' plot(0,0,type="n",xlim=c(-1.5,1.5),ylim=c(-1.5,1.5),asp=1) #' network.vertex(cos((1:10)/10*2*pi),sin((1:10)/10*2*pi),col=1:10, #' sides=3:12,radius=0.1) #' #' #' @export network.vertex network.vertex<-function(x,y,radius=1,sides=4,border=1,col=2,lty=NULL,rot=0,lwd=1,...){ #Prep the vars n<-length(x) radius<-rep(radius,length=n) sides<-rep(sides,length=n) border<-rep(border,length=n) col<-rep(col,length=n) lty<-rep(lty,length=n) rot<-rep(rot,length=n) lwd<-rep(lwd,length=n) #Obtain the coordinates coord<-vector() for(i in 1:length(x)) { coord<-make.vertex.poly.coords(x[i],y[i],radius[i],sides[i],rot[i]) polygon(coord,border=border[i],col=col[i],lty=lty[i],lwd=lwd[i], ...) } #Plot the polygons } # draw a label for a network edge #' Plots a label corresponding to an edge in a network plot. #' #' Draws a text labels on (or adjacent to) the line segments connecting #' vertices on a network plot. #' #' Called internally by \code{\link{plot.network}} when \code{edge.label} #' parameter is used. For directed, non-curved edges, the labels are shifted #' towards the tail of the edge. Labels for curved edges are not shifted #' because opposite-direction edges curve the opposite way. Makes a crude #' attempt to shift labels to either side of line, and to draw the edge labels #' for self-loops near the vertex. No attempt is made to avoid overlap between #' vertex and edge labels. #' #' @param px0 vector of x coordinates of tail vertex of the edge #' @param py0 vector of y coordinates of tail vertex of the edge #' @param px1 vector of x coordinates of head vertex of the edge #' @param py1 vector of y coordinate of head vertex of the edge #' @param label vector strings giving labels to be drawn for edge edge #' @param directed logical: is the underlying network directed? If FALSE, #' labels will be drawn in the middle of the line segment, otherwise in the #' first 3rd so that the labels for edges pointing in the opposite direction #' will not overlap. #' @param loops logical: if true, assuming the labels to be drawn belong to #' loop-type edges and render appropriately #' @param cex numeric vector giving the text expansion factor for each label #' @param curve numeric vector controling the extent of edge curvature (0 = #' straight line edges) #' @param \dots additional arguments to be passed to \code{\link{text}} #' @return no value is returned but text will be rendered on the active plot #' @author skyebend #' @export network.edgelabel network.edgelabel<-function(px0,py0,px1,py1,label,directed,loops=FALSE,cex,curve=0,...){ curve<-rep(curve,length(label)) posl<-rep(0,length(label)) offsets<-rep(0.1,length(label)) if (loops){ # loops version # assume coordinates are the first pair # math is hard. For now just draw label near the vertex lpx<-px0 lpy<-py0 # compute crude offset so that label doesn't land on vertex # todo, this doesn't work well on all edge orientations posl<-rep(0,length(label)) posl[(px0>px1) & (py0>py1)]<-4 posl[(px0<=px1) & (py0<=py1)]<-2 posl[(px0>px1) & (py0<=py1)]<-1 posl[(px0<=px1) & (py0>py1)]<-3 offsets<-rep(0.5,length(label)) } else { # either curved or straight line if (all(curve==0)){ # straight line non-curved version if (directed){ # draw labels off center of line so won't overlap lpx<-px0+((px1-px0)/3) lpy<-py0+((py1-py0)/3) } else { # draw labels on center of line lpx<-px0+((px1-px0)/2) lpy<-py0+((py1-py0)/2) # assumes that line is straight } } else { # curved edge case coords<-sapply(seq_len(length(label)),function(p){ make.arrow.poly.coords(px0[p],py0[p],px1[p],py1[p],ahangle = 0,ahlen=0,swid = 0,toff = 0,hoff=0,ahead = 0,curve=curve[p],csteps=2)[2,] # pick a point returned from the middle of the curve }) lpx<-coords[1,] lpy<-coords[2,] # this should } # compute crude offset so that label doesn't land on line # todo, this doesn't work well on all edge orientations posl[(px0>px1) & (py0>py1)]<-1 posl[(px0<=px1) & (py0<=py1)]<-3 posl[(px0>px1) & (py0<=py1)]<-2 posl[(px0<=px1) & (py0>py1)]<-4 } # debug coord location text(lpx,lpy,labels=label,cex=cex,pos=posl,offset=offsets,...) } #Generic plot.network method. #' Two-Dimensional Visualization for Network Objects #' #' \code{plot.network} produces a simple two-dimensional plot of network #' \code{x}, using optional attribute \code{attrname} to set edge values. A #' variety of options are available to control vertex placement, display #' details, color, etc. #' #' \code{plot.network} is the standard visualization tool for the #' \code{network} class. By means of clever selection of display parameters, a #' fair amount of display flexibility can be obtained. Vertex layout -- if not #' specified directly using \code{coord} -- is determined via one of the #' various available algorithms. These should be specified via the \code{mode} #' argument; see \code{\link{network.layout}} for a full list. User-supplied #' layout functions are also possible -- see the aforementioned man page for #' details. #' #' Note that where \code{is.hyper(x)==TRUE}, the network is converted to #' bipartite adjacency form prior to computing coordinates. If #' \code{interactive==TRUE}, then the user may modify the initial network #' layout by selecting an individual vertex and then clicking on the location #' to which this vertex is to be moved; this process may be repeated until the #' layout is satisfactory. #' #' @rdname plot.network #' @name plot.network.default #' #' @param x an object of class \code{network}. #' @param attrname an optional edge attribute, to be used to set edge values. #' @param label a vector of vertex labels, if desired; defaults to the vertex #' labels returned by \code{\link{network.vertex.names}}. If \code{label} has #' one element and it matches with a vertex attribute name, the value of the #' attribute will be used. Note that labels may be set but hidden by the #' \code{displaylabels} argument. #' @param coord user-specified vertex coordinates, in an network.size(x)x2 #' matrix. Where this is specified, it will override the \code{mode} setting. #' @param jitter boolean; should the output be jittered? #' @param thresh real number indicating the lower threshold for tie values. #' Only ties of value >\code{thresh} are displayed. By default, #' \code{thresh}=0. #' @param usearrows boolean; should arrows (rather than line segments) be used #' to indicate edges? #' @param mode the vertex placement algorithm; this must correspond to a #' \code{\link{network.layout}} function. #' @param displayisolates boolean; should isolates be displayed? #' @param interactive boolean; should interactive adjustment of vertex #' placement be attempted? #' @param xlab x axis label. #' @param ylab y axis label. #' @param xlim the x limits (min, max) of the plot. #' @param ylim the y limits of the plot. #' @param pad amount to pad the plotting range; useful if labels are being #' clipped. #' @param label.pad amount to pad label boxes (if \code{boxed.labels==TRUE}), #' in character size units. #' @param displaylabels boolean; should vertex labels be displayed? #' @param boxed.labels boolean; place vertex labels within boxes? #' @param label.pos position at which labels should be placed, relative to #' vertices. \code{0} results in labels which are placed away from the center #' of the plotting region; \code{1}, \code{2}, \code{3}, and \code{4} result in #' labels being placed below, to the left of, above, and to the right of #' vertices (respectively); and \code{label.pos>=5} results in labels which are #' plotted with no offset (i.e., at the vertex positions). #' @param label.bg background color for label boxes (if #' \code{boxed.labels==TRUE}); may be a vector, if boxes are to be of different #' colors. #' @param vertex.sides number of polygon sides for vertices; may be given as a #' vector or a vertex attribute name, if vertices are to be of different types. #' As of v1.12, radius of polygons are scaled so that all shapes have equal #' area #' @param vertex.rot angle of rotation for vertices (in degrees); may be given #' as a vector or a vertex attribute name, if vertices are to be rotated #' differently. #' @param vertex.lwd line width of vertex borders; may be given as a vector or #' a vertex attribute name, if vertex borders are to have different line #' widths. #' @param arrowhead.cex expansion factor for edge arrowheads. #' @param label.cex character expansion factor for label text. #' @param loop.cex expansion factor for loops; may be given as a vector or a #' vertex attribute name, if loops are to be of different sizes. #' @param vertex.cex expansion factor for vertices; may be given as a vector or #' a vertex attribute name, if vertices are to be of different sizes. #' @param edge.col color for edges; may be given as a vector, adjacency matrix, #' or edge attribute name, if edges are to be of different colors. #' @param label.col color for vertex labels; may be given as a vector or a #' vertex attribute name, if labels are to be of different colors. #' @param vertex.col color for vertices; may be given as a vector or a vertex #' attribute name, if vertices are to be of different colors. #' @param label.border label border colors (if \code{boxed.labels==TRUE}); may #' be given as a vector, if label boxes are to have different colors. #' @param vertex.border border color for vertices; may be given as a vector or #' a vertex attribute name, if vertex borders are to be of different colors. #' @param edge.lty line type for edge borders; may be given as a vector, #' adjacency matrix, or edge attribute name, if edge borders are to have #' different line types. #' @param label.lty line type for label boxes (if \code{boxed.labels==TRUE}); #' may be given as a vector, if label boxes are to have different line types. #' @param vertex.lty line type for vertex borders; may be given as a vector or #' a vertex attribute name, if vertex borders are to have different line types. #' @param edge.lwd line width scale for edges; if set greater than 0, edge #' widths are scaled by \code{edge.lwd*dat}. May be given as a vector, #' adjacency matrix, or edge attribute name, if edges are to have different #' line widths. #' @param edge.label if non-\code{NULL}, labels for edges will be drawn. May be #' given as a vector, adjacency matrix, or edge attribute name, if edges are to #' have different labels. A single value of \code{TRUE} will use edge ids as #' labels. NOTE: currently doesn't work for curved edges. #' @param edge.label.cex character expansion factor for edge label text; may be #' given as a vector or a edge attribute name, if edge labels are to have #' different sizes. #' @param edge.label.col color for edge labels; may be given as a vector or a #' edge attribute name, if labels are to be of different colors. #' @param label.lwd line width for label boxes (if \code{boxed.labels==TRUE}); #' may be given as a vector, if label boxes are to have different line widths. #' @param edge.len if \code{uselen==TRUE}, curved edge lengths are scaled by #' \code{edge.len}. #' @param edge.curve if \code{usecurve==TRUE}, the extent of edge curvature is #' controlled by \code{edge.curv}. May be given as a fixed value, vector, #' adjacency matrix, or edge attribute name, if edges are to have different #' levels of curvature. #' @param edge.steps for curved edges (excluding loops), the number of line #' segments to use for the curve approximation. #' @param loop.steps for loops, the number of line segments to use for the #' curve approximation. #' @param object.scale base length for plotting objects, as a fraction of the #' linear scale of the plotting region. Defaults to 0.01. #' @param uselen boolean; should we use \code{edge.len} to rescale edge #' lengths? #' @param usecurve boolean; should we use \code{edge.curve}? #' @param suppress.axes boolean; suppress plotting of axes? #' @param vertices.last boolean; plot vertices after plotting edges? #' @param new boolean; create a new plot? If \code{new==FALSE}, vertices and #' edges will be added to the existing plot. #' @param layout.par parameters to the \code{\link{network.layout}} function #' specified in \code{mode}. #' @param \dots additional arguments to \code{\link{plot}}. #' @return A two-column matrix containing the vertex positions as x,y #' coordinates #' @note \code{plot.network} is adapted (with minor modifications) from the #' \code{\link[sna]{gplot}} function of the \code{sna} library (authors: Carter #' T. Butts and Alex Montgomery); eventually, these two packages will be #' integrated. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network}}, \code{\link{network.arrow}}, #' \code{\link{network.loop}}, \code{\link{network.vertex}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \url{https://www.jstatsoft.org/v24/i02/} #' #' Wasserman, S., and Faust, K. (1994). \emph{Social Network Analysis: #' Methods and Applications.} Cambridge: Cambridge University Press. #' @keywords hplot graphs #' @examples #' #' #Construct a sparse graph #' m<-matrix(rbinom(100,1,1.5/9),10) #' diag(m)<-0 #' g<-network(m) #' #' #Plot the graph #' plot(g) #' #' #Load Padgett's marriage data #' data(flo) #' nflo<-network(flo) #' #Display the network, indicating degree and flagging the Medicis #' plot(nflo, vertex.cex=apply(flo,2,sum)+1, usearrows=FALSE, #' vertex.sides=3+apply(flo,2,sum), #' vertex.col=2+(network.vertex.names(nflo)=="Medici")) #' @export plot.network #' @export plot.network <- function(x, ...){ plot.network.default(x, ...) } #Two-dimensional network visualization; this was originally a direct port of the gplot #routine from sna (Carter T. Butts ) #' @rdname plot.network #' @usage \method{plot.network}{default}(x, attrname = NULL, #' label = network.vertex.names(x), coord = NULL, jitter = TRUE, #' thresh = 0, usearrows = TRUE, mode = "fruchtermanreingold", #' displayisolates = TRUE, interactive = FALSE, xlab = NULL, #' ylab = NULL, xlim = NULL, ylim = NULL, pad = 0.2, label.pad = 0.5, #' displaylabels = !missing(label), boxed.labels = FALSE, label.pos = 0, #' label.bg = "white", vertex.sides = 50, vertex.rot = 0, vertex.lwd=1, #' arrowhead.cex = 1, label.cex = 1, loop.cex = 1, vertex.cex = 1, #' edge.col = 1, label.col = 1, vertex.col = 2, label.border = 1, #' vertex.border = 1, edge.lty = 1, label.lty = NULL, vertex.lty = 1, #' edge.lwd = 0, edge.label = NULL, edge.label.cex = 1, #' edge.label.col = 1, label.lwd = par("lwd"), edge.len = 0.5, #' edge.curve = 0.1, edge.steps = 50, loop.steps = 20, #' object.scale = 0.01, uselen = FALSE, usecurve = FALSE, #' suppress.axes = TRUE, vertices.last = TRUE, new = TRUE, #' layout.par = NULL, \dots) #' @export plot.network.default #' @rawNamespace S3method(plot.network,default) plot.network.default<-function(x, attrname=NULL, label=network.vertex.names(x), coord=NULL, jitter=TRUE, thresh=0, usearrows=TRUE, mode="fruchtermanreingold", displayisolates=TRUE, interactive=FALSE, xlab=NULL, ylab=NULL, xlim=NULL, ylim=NULL, pad=0.2, label.pad=0.5, displaylabels=!missing(label), boxed.labels=FALSE, label.pos=0, label.bg="white", vertex.sides=50, vertex.rot=0, vertex.lwd=1, arrowhead.cex=1, label.cex=1, loop.cex=1, vertex.cex=1, edge.col=1, label.col=1, vertex.col=2, label.border=1, vertex.border=1, edge.lty=1, label.lty=NULL, vertex.lty=1, edge.lwd=0, edge.label=NULL, edge.label.cex=1, edge.label.col=1, label.lwd=par("lwd"), edge.len=0.5, edge.curve=0.1, edge.steps=50, loop.steps=20, object.scale=0.01, uselen=FALSE, usecurve=FALSE, suppress.axes=TRUE, vertices.last=TRUE, new=TRUE, layout.par=NULL, ...){ #Check to see that things make sense if(!is.network(x)) stop("plot.network requires a network object.") if(network.size(x)==0) stop("plot.network called on a network of order zero - nothing to plot.") #Turn the annoying locator bell off, and remove recursion limit bellstate<-options()$locatorBell expstate<-options()$expression on.exit(options(locatorBell=bellstate,expression=expstate)) options(locatorBell=FALSE,expression=Inf) #Create a useful interval inclusion operator "%iin%"<-function(x,int) (x>=int[1])&(x<=int[2]) #Extract the network to be displayed if(is.hyper(x)){ #Is this a hypergraph? If so, use two-mode form. #Create a new graph to store the two-mode structure xh<-network.initialize(network.size(x)+sum(!sapply(x$mel, is.null)), directed=is.directed(x)) #Port attributes, in case we need them for(i in list.vertex.attributes(x)){ set.vertex.attribute(xh,attrname=i, value=get.vertex.attribute(x,attrname=i,null.na=FALSE,unlist=FALSE), v=1:network.size(x)) } for(i in list.network.attributes(x)){ if(!(i%in%c("bipartite","directed","hyper","loops","mnext","multiple", "n"))) set.network.attribute(xh,attrname=i, value=get.network.attribute(x,attrname=i,unlist=FALSE)) } #Now, import the edges cnt<-1 for(i in 1:length(x$mel)){ #Not a safe way to do this, long-term if(!is.null(x$mel[[i]])){ for(j in x$mel[[i]]$outl){ if(!is.adjacent(xh,j,network.size(x)+cnt)) add.edge(xh,j,network.size(x)+cnt,names.eval=names(x$mel[[i]]$atl), vals.eval=x$mel[[i]]$atl) } for(j in x$mel[[i]]$inl){ if(!is.adjacent(xh,network.size(x)+cnt,j)){ add.edge(xh,network.size(x)+cnt,j,names.eval=names(x$mel[[i]]$atl), vals.eval=x$mel[[i]]$atl) } } cnt<-cnt+1 #Increment the edge counter } } cnt<-cnt-1 if(length(label)==network.size(x)) #Fix labels, if needed label<-c(label,paste("e",1:cnt,sep="")) xh%v%"vertex.names"<-c(x%v%"vertex.names",paste("e",1:cnt,sep="")) x<-xh n<-network.size(x) d<-as.matrix.network(x,matrix.type="edgelist",attrname=attrname) if(!is.directed(x)) usearrows<-FALSE }else if(is.bipartite(x)){ n<-network.size(x) d<-as.matrix.network(x,matrix.type="edgelist",attrname=attrname) usearrows<-FALSE }else{ n<-network.size(x) d<-as.matrix.network(x,matrix.type="edgelist",attrname=attrname) if(!is.directed(x)) usearrows<-FALSE } #Make sure that edge values are in place, matrix has right shape, etc. if(NCOL(d)==2){ if(NROW(d)==0) d<-matrix(nrow=0,ncol=3) else d<-cbind(d,rep(1,NROW(d))) } diag<-has.loops(x) #Check for existence of loops #Replace NAs with 0s d[is.na(d)]<-0 #Determine which edges should be used when plotting edgetouse<-d[,3]>thresh d<-d[edgetouse,,drop=FALSE] #Save original matrix, which we may use below d.raw<-d #Determine coordinate placement if(!is.null(coord)){ #If the user has specified coords, override all other considerations cx<-coord[,1] cy<-coord[,2] }else{ #Otherwise, use the specified layout function layout.fun<-try(match.fun(paste("network.layout.",mode,sep="")), silent=TRUE) if(inherits(layout.fun,"try-error")) stop("Error in plot.network.default: no layout function for mode ",mode) temp<-layout.fun(x,layout.par) cx<-temp[,1] cy<-temp[,2] } #Jitter the coordinates if need be if(jitter){ cx<-jitter(cx) cy<-jitter(cy) } #Which nodes should we use? use<-displayisolates|(((sapply(x$iel,length)+sapply(x$oel,length))>0)) #Deal with axis labels if(is.null(xlab)) xlab="" if(is.null(ylab)) ylab="" #Set limits for plotting region if(is.null(xlim)) xlim<-c(min(cx[use])-pad,max(cx[use])+pad) #Save x, y limits if(is.null(ylim)) ylim<-c(min(cy[use])-pad,max(cy[use])+pad) xrng<-diff(xlim) #Force scale to be symmetric yrng<-diff(ylim) xctr<-(xlim[2]+xlim[1])/2 #Get center of plotting region yctr<-(ylim[2]+ylim[1])/2 if(xrng0){ #Edge color edge.col<-plotArgs.network(x,'edge.col',edge.col,d=d) #Edge line type edge.lty<-plotArgs.network(x,'edge.lty',edge.lty,d=d) #Edge line width edge.lwd<-plotArgs.network(x,'edge.lwd',edge.lwd,d=d) #Edge curve # TODO: can't move this into prepare plot args becaue it also sets the e.curve.as.mult # but I think it could be refactored to use the d[] array as the other edge functions do if(!is.null(edge.curve)){ if(length(dim(edge.curve))==2){ edge.curve<-edge.curve[d[,1:2]] e.curv.as.mult<-FALSE }else{ if(length(edge.curve)==1) e.curv.as.mult<-TRUE else e.curv.as.mult<-FALSE edge.curve<-rep(edge.curve,length=NROW(d)) } }else if(is.character(edge.curve)&&(length(edge.curve)==1)){ temp<-edge.curve edge.curve<-(x%e%edge.curve)[edgetouse] if(all(is.na(edge.curve))) stop("Attribute '",temp,"' had illegal missing values for edge.curve or was not present in plot.network.default.") e.curv.as.mult<-FALSE }else{ edge.curve<-rep(0,length=NROW(d)) e.curv.as.mult<-FALSE } # only evaluate edge label stuff if we will draw label if(!is.null(edge.label)){ #Edge label edge.label<-plotArgs.network(x,'edge.label',edge.label,d=d) #Edge label color edge.label.col<-plotArgs.network(x,'edge.label.col',edge.label.col,d=d) #Edge label cex edge.label.cex<-plotArgs.network(x,'edge.label.cex',edge.label.cex,d=d) } # end edge label setup block #Proceed with edge setup dist<-((cx[d[,1]]-cx[d[,2]])^2+(cy[d[,1]]-cy[d[,2]])^2)^0.5 #Get the inter-point distances for curves tl<-d.raw*dist #Get rescaled edge lengths tl.max<-max(tl) #Get maximum edge length for(i in 1:NROW(d)){ if(use[d[i,1]]&&use[d[i,2]]){ #Plot edges for displayed vertices (wait,doesn't 'use' track isolates, which don't have edges anyway?) px0[i]<-as.double(cx[d[i,1]]) #Store endpoint coordinates py0[i]<-as.double(cy[d[i,1]]) px1[i]<-as.double(cx[d[i,2]]) py1[i]<-as.double(cy[d[i,2]]) e.toff[i]<-vertex.radius[d[i,1]] #Store endpoint offsets e.hoff[i]<-vertex.radius[d[i,2]] e.col[i]<-edge.col[i] #Store other edge attributes e.type[i]<-edge.lty[i] e.lwd[i]<-edge.lwd[i] e.diag[i]<-d[i,1]==d[i,2] #Is this a loop? e.rad[i]<-vertex.radius[d[i,1]]*loop.cex[d[i,1]] if(uselen){ #Should we base curvature on interpoint distances? if(tl[i]>0){ e.len<-dist[i]*tl.max/tl[i] e.curv[i]<-edge.len*sqrt((e.len/2)^2-(dist[i]/2)^2) }else{ e.curv[i]<-0 } }else{ #Otherwise, use prespecified edge.curve if(e.curv.as.mult) #If it's a scalar, multiply by edge str e.curv[i]<-edge.curve[i]*d.raw[i] else e.curv[i]<-edge.curve[i] } } } }# end edges block #Plot loops for the diagonals, if diag==TRUE, rotating wrt center of mass if(diag&&(length(px0)>0)&&sum(e.diag>0)){ #Are there any loops present? network.loop(as.vector(px0)[e.diag],as.vector(py0)[e.diag], length=1.5*baserad*arrowhead.cex,angle=25,width=e.lwd[e.diag]*baserad/10,col=e.col[e.diag],border=e.col[e.diag],lty=e.type[e.diag],offset=e.hoff[e.diag],edge.steps=loop.steps,radius=e.rad[e.diag],arrowhead=usearrows,xctr=mean(cx[use]),yctr=mean(cy[use])) if(!is.null(edge.label)){ network.edgelabel(px0,py0,0,0,edge.label[e.diag],directed=is.directed(x),cex=edge.label.cex[e.diag],col=edge.label.col[e.diag],loops=TRUE) } } #Plot standard (i.e., non-loop) edges if(length(px0)>0){ #If edges are present, remove loops from consideration px0<-px0[!e.diag] py0<-py0[!e.diag] px1<-px1[!e.diag] py1<-py1[!e.diag] e.curv<-e.curv[!e.diag] e.lwd<-e.lwd[!e.diag] e.type<-e.type[!e.diag] e.col<-e.col[!e.diag] e.hoff<-e.hoff[!e.diag] e.toff<-e.toff[!e.diag] e.rad<-e.rad[!e.diag] } if(!usecurve&!uselen){ #Straight-line edge case if(length(px0)>0){ network.arrow(as.vector(px0),as.vector(py0),as.vector(px1), as.vector(py1),length=2*baserad*arrowhead.cex,angle=20,col=e.col,border=e.col,lty=e.type,width=e.lwd*baserad/10,offset.head=e.hoff,offset.tail=e.toff,arrowhead=usearrows) if(!is.null(edge.label)){ network.edgelabel(px0,py0,px1,py1,edge.label[!e.diag],directed=is.directed(x),cex=edge.label.cex[!e.diag],col=edge.label.col[!e.diag]) } } }else{ #Curved edge case if(length(px0)>0){ network.arrow(as.vector(px0),as.vector(py0),as.vector(px1), as.vector(py1),length=2*baserad*arrowhead.cex,angle=20,col=e.col,border=e.col,lty=e.type,width=e.lwd*baserad/10,offset.head=e.hoff,offset.tail=e.toff,arrowhead=usearrows,curve=e.curv,edge.steps=edge.steps) if(!is.null(edge.label)){ network.edgelabel(px0,py0,px1,py1,edge.label[!e.diag],directed=is.directed(x),cex=edge.label.cex[!e.diag],col=edge.label.col[!e.diag],curve=e.curv) } } } #Plot vertices now, if we haven't already done so if(vertices.last) network.vertex(cx[use],cy[use],radius=vertex.radius[use], sides=vertex.sides[use],col=vertex.col[use],border=vertex.border[use],lty=vertex.lty[use],rot=vertex.rot[use], lwd=vertex.lwd[use]) #Plot vertex labels, if needed if(displaylabels&(!all(label==""))&(!all(use==FALSE))){ if (label.pos==0){ xhat <- yhat <- rhat <- rep(0,n) #Set up xoff yoff and roff when we get odd vertices xoff <- cx[use]-mean(cx[use]) yoff <- cy[use]-mean(cy[use]) roff <- sqrt(xoff^2+yoff^2) #Loop through vertices for (i in (1:n)[use]){ #Find all in and out ties that aren't loops ij <- unique(c(d[d[,2]==i&d[,1]!=i,1],d[d[,1]==i&d[,2]!=i,2])) ij.n <- length(ij) if (ij.n>0) { #Loop through all ties and add each vector to label direction for (j in ij){ dx <- cx[i]-cx[j] dy <- cy[i]-cy[j] dr <- sqrt(dx^2+dy^2) xhat[i] <- xhat[i]+dx/dr yhat[i] <- yhat[i]+dy/dr } #Take the average of all the ties xhat[i] <- xhat[i]/ij.n yhat[i] <- yhat[i]/ij.n rhat[i] <- sqrt(xhat[i]^2+yhat[i]^2) if (!is.nan(rhat[i]) && rhat[i]!=0) { # watch out for NaN when vertices have same position # normalize direction vector xhat[i] <- xhat[i]/rhat[i] yhat[i] <- yhat[i]/rhat[i] } else { #if no direction, make xhat and yhat away from center xhat[i] <- xoff[i]/roff[i] yhat[i] <- yoff[i]/roff[i] } } else { #if no ties, make xhat and yhat away from center xhat[i] <- xoff[i]/roff[i] yhat[i] <- yoff[i]/roff[i] } if ( is.nan(xhat[i]) || xhat[i]==0 ) xhat[i] <- .01 #jitter to avoid labels on points if (is.nan(yhat[i]) || yhat[i]==0 ) yhat[i] <- .01 } xhat <- xhat[use] yhat <- yhat[use] } else if (label.pos<5) { xhat <- switch(label.pos,0,-1,0,1) yhat <- switch(label.pos,-1,0,1,0) } else if (label.pos==6) { xoff <- cx[use]-mean(cx[use]) yoff <- cy[use]-mean(cy[use]) roff <- sqrt(xoff^2+yoff^2) xhat <- xoff/roff yhat <- yoff/roff } else { xhat <- 0 yhat <- 0 } os<-par()$cxy*mean(label.cex,na.rm = TRUE) # don't think this is actually used? lw<-strwidth(label[use],cex=label.cex)/2 lh<-strheight(label[use],cex=label.cex)/2 if(boxed.labels){ rect(cx[use]+xhat*vertex.radius[use]-(lh*label.pad+lw)*((xhat<0)*2+ (xhat==0)*1), cy[use]+yhat*vertex.radius[use]-(lh*label.pad+lh)*((yhat<0)*2+ (yhat==0)*1), cx[use]+xhat*vertex.radius[use]+(lh*label.pad+lw)*((xhat>0)*2+ (xhat==0)*1), cy[use]+yhat*vertex.radius[use]+(lh*label.pad+lh)*((yhat>0)*2+ (yhat==0)*1), col=label.bg,border=label.border,lty=label.lty,lwd=label.lwd) } text(cx[use]+xhat*vertex.radius[use]+(lh*label.pad+lw)*((xhat>0)-(xhat<0)), cy[use]+yhat*vertex.radius[use]+(lh*label.pad+lh)*((yhat>0)-(yhat<0)), label[use],cex=label.cex,col=label.col,offset=0) } #If interactive, allow the user to mess with things if(interactive&&((length(cx)>0)&&(!all(use==FALSE)))){ #Set up the text offset increment os<-c(0.2,0.4)*par()$cxy #Get the location for text messages, and write to the screen textloc<-c(min(cx[use])-pad,max(cy[use])+pad) tm<-"Select a vertex to move, or click \"Finished\" to end." tmh<-strheight(tm) tmw<-strwidth(tm) text(textloc[1],textloc[2],tm,adj=c(0,0.5)) #Print the initial instruction fm<-"Finished" finx<-c(textloc[1],textloc[1]+strwidth(fm)) finy<-c(textloc[2]-3*tmh-strheight(fm)/2,textloc[2]-3*tmh+strheight(fm)/2) finbx<-finx+c(-os[1],os[1]) finby<-finy+c(-os[2],os[2]) rect(finbx[1],finby[1],finbx[2],finby[2],col="white") text(finx[1],mean(finy),fm,adj=c(0,0.5)) #Get the click location clickpos<-unlist(locator(1)) #If the click is in the "finished" box, end our little game. Otherwise, #relocate a vertex and redraw. if((clickpos[1]%iin%finbx)&&(clickpos[2]%iin%finby)){ cl<-match.call() #Get the args of the current function cl$interactive<-FALSE #Turn off interactivity cl$coord<-cbind(cx,cy) #Set the coordinates cl$x<-x #"Fix" the data array return(eval.parent(cl)) #Execute the function and return }else{ #Figure out which vertex was selected clickdis<-sqrt((clickpos[1]-cx[use])^2+(clickpos[2]-cy[use])^2) selvert<-match(min(clickdis),clickdis) #Create usable labels, if the current ones aren't if(all(label=="")) label<-1:n #Clear out the old message, and write a new one rect(textloc[1],textloc[2]-tmh/2,textloc[1]+tmw,textloc[2]+tmh/2, border="white",col="white") tm<-"Where should I move this vertex?" tmh<-strheight(tm) tmw<-strwidth(tm) text(textloc[1],textloc[2],tm,adj=c(0,0.5)) fm<-paste("Vertex",label[use][selvert],"selected") finx<-c(textloc[1],textloc[1]+strwidth(fm)) finy<-c(textloc[2]-3*tmh-strheight(fm)/2,textloc[2]-3*tmh+ strheight(fm)/2) finbx<-finx+c(-os[1],os[1]) finby<-finy+c(-os[2],os[2]) rect(finbx[1],finby[1],finbx[2],finby[2],col="white") text(finx[1],mean(finy),fm,adj=c(0,0.5)) #Get the destination for the new vertex clickpos<-unlist(locator(1)) #Set the coordinates accordingly cx[use][selvert]<-clickpos[1] cy[use][selvert]<-clickpos[2] #Iterate (leaving interactivity on) cl<-match.call() #Get the args of the current function cl$coord<-cbind(cx,cy) #Set the coordinates cl$x<-x #"Fix" the data array return(eval.parent(cl)) #Execute the function and return } } #Return the vertex positions, should they be needed invisible(cbind(cx,cy)) } # moving all of the plot argument checking and expansion into a single function # so that it will be acessible from other plot-related tools (like ndtv) # argName = character named of argument to be checked/expaneded # argValue = value passed in by user, to be processed/expanded # d is an edgelist matrix of edge values optionally used by some edge attribute functions # edgetouse the set of edge ids to be used (in case some edges are not being shown) #' Expand and transform attributes of networks to values appropriate for #' aguments to plot.network #' #' This is primairly an internal function called by \code{plot.network} or by #' external packages such as \code{ndtv} that want to prepare #' \code{plot.network} graphic arguments in a standardized way. #' #' Given a network object, the name of graphic parameter argument to #' \code{plot.network} and value, it will if necessary transform the value, or #' extract it from the network, according to the description in #' \code{\link{plot.network}}. For some attributes, if the value is the name of #' a vertex or edge attribute, the appropriate values will be extracted from #' the network before transformation. #' #' @rdname preparePlotArgs #' @name plotArgs.network #' #' @param x a \code{network} object which is going to be plotted #' @param argName character, the name of \code{plot.network} graphic parameter #' @param argValue value for the graphic paramter named in \code{argName} which #' to be transformed/prepared. For many attributes, if this is a single #' character vector it will be assumed to be the name of a vertex or edge #' attribute to be extracted and transformed #' @param d is an edgelist matrix of edge values optionally used by some edge #' attribute functions #' @param edgetouse numeric vector giving set of edge ids to be used (in case #' some edges are not being shown) required by some attributes #' @return returns a vector with length corresponding to the number of vertices #' or edges (depending on the paramter type) giving the appropriately prepared #' values for the parameter type. If the values or specified attribute can not #' be processed correctly, and Error may occur. #' @author skyebend@@uw.edu #' @seealso See also \code{\link{plot.network}} #' @examples #' #' net<-network.initialize(3) #' set.vertex.attribute(net,'color',c('red','green','blue')) #' set.vertex.attribute(net,'charm',1:3) #' # replicate a single colorname value #' plotArgs.network(net,'vertex.col','purple') #' # map the 'color' attribute to color #' plotArgs.network(net,'vertex.col','color') #' # similarly for a numeric attribute ... #' plotArgs.network(net,'vertex.cex',12) #' plotArgs.network(net,'vertex.cex','charm') #' #' @export plotArgs.network plotArgs.network<-function(x,argName, argValue,d=NULL,edgetouse=NULL){ n<-network.size(x) # count the number of edges # not sure if nrow d is every differnt, than network edgecount, but just being safe if(!is.null(d)){ nE<-NROW(d) } else { nE<-network.edgecount(x) } if(is.null(edgetouse)){ edgetouse<-seq_len(nE) # use all the edges } # if d exists, it may need to be subset to the number of edges if (!is.null(d)){ d<-d[edgetouse,,drop=FALSE] } # assign the value to a local variable with the appropriate name assign(argName,argValue) #Fill out vertex vectors; assume we're using attributes if chars used # TODO: only one of the code blocks below should execute, set up as a switch? switch(argName, # ----- vertex labels --------------------------- label=if(is.character(label)&(length(label)==1)){ temp<-label if(temp%in%list.vertex.attributes(x)){ label <- rep(get.vertex.attribute(x,temp),length=n) if(all(is.na(label))){ stop("Attribute '",temp,"' had illegal missing values for label or was not present in plot.network.default.") } } else { # didn't match with a vertex attribute, assume we are supposed to replicate it label <- rep(label,length=n) } }else{ label <- rep(as.character(label),length=n) } , # ------ vertex sizes (vertex.cex) -------------------- vertex.cex=if(is.character(vertex.cex)&(length(vertex.cex)==1)){ temp<-vertex.cex vertex.cex <- rep(get.vertex.attribute(x,vertex.cex),length=n) if(all(is.na(vertex.cex))) stop("Attribute '",temp,"' had illegal missing values for vertex.cex or was not present in plot.network.default.") }else vertex.cex <- rep(vertex.cex,length=n) , # ------ vertex sides (number of sides for polygon) --------- vertex.sides=if(is.character(vertex.sides)&&(length(vertex.sides==1))){ temp<-vertex.sides vertex.sides <- rep(get.vertex.attribute(x,vertex.sides),length=n) if(all(is.na(vertex.sides))) stop("Attribute '",temp,"' had illegal missing values for vertex.sides or was not present in plot.network.default.") }else vertex.sides <- rep(vertex.sides,length=n) , # --------- vertex border -------------------- vertex.border=if(is.character(vertex.border)&&(length(vertex.border)==1)){ temp<-vertex.border vertex.border <- rep(get.vertex.attribute(x,vertex.border),length=n) if(all(is.na(vertex.border))) vertex.border <- rep(temp,length=n) #Assume it was a color word else{ if(!all(is.color(vertex.border),na.rm=TRUE)) vertex.border<-as.color(vertex.border) } }else vertex.border <- rep(vertex.border,length=n) , # -------- vertex color ------------------------ vertex.col=if(is.character(vertex.col)&&(length(vertex.col)==1)){ temp<-vertex.col vertex.col <- rep(get.vertex.attribute(x,vertex.col),length=n) if(all(is.na(vertex.col))) vertex.col <- rep(temp,length=n) #Assume it was a color word else{ if(!all(is.color(vertex.col),na.rm=TRUE)) vertex.col<-as.color(vertex.col) } }else vertex.col <- rep(vertex.col,length=n) , # ------- vertex line type (vertex.lty) -------------------- vertex.lty=if(is.character(vertex.lty)&&(length(vertex.lty)==1)){ temp<-vertex.lty vertex.lty <- rep(get.vertex.attribute(x,vertex.lty),length=n) if(all(is.na(vertex.lty))) stop("Attribute '",temp,"' had illegal missing values for vertex.col or was not present in plot.network.default.") }else vertex.lty <- rep(vertex.lty,length=n) , # ------- vertex rotation -------------------------------------- vertex.rot=if(is.character(vertex.rot)&&(length(vertex.rot)==1)){ temp<-vertex.rot vertex.rot <- rep(get.vertex.attribute(x,vertex.rot),length=n) if(all(is.na(vertex.rot))) stop("Attribute '",temp,"' had illegal missing values for vertex.rot or was not present in plot.network.default.") }else vertex.rot <- rep(vertex.rot,length=n) , # -------- vertex line width -------------------------- vertex.lwd=if(is.character(vertex.lwd)&&(length(vertex.lwd)==1)){ temp<-vertex.lwd vertex.lwd <- rep(get.vertex.attribute(x,vertex.lwd),length=n) if(all(is.na(vertex.lwd))) stop("Attribute '",temp,"' had illegal missing values for vertex.lwd or was not present in plot.network.default.") }else vertex.lwd <- rep(vertex.lwd,length=n) , # -------- vertex self-loop size ----------------------- loop.cex=if(is.character(loop.cex)&&(length(loop.cex)==1)){ temp<-loop.cex loop.cex <- rep(get.vertex.attribute(x,loop.cex),length=n) if(all(is.na(loop.cex))) stop("Attribute ",temp," had illegal missing values for loop.cex or was not present in plot.network.default.") }else loop.cex <- rep(loop.cex,length=n) , # --------- vertex label color ----------------------------- label.col=if(is.character(label.col)&&(length(label.col)==1)){ temp<-label.col label.col <- rep(get.vertex.attribute(x,label.col),length=n) if(all(is.na(label.col))) label.col <- rep(temp,length=n) #Assume it was a color word else{ if(!all(is.color(label.col),na.rm=TRUE)) label.col<-as.color(label.col) } }else label.col <- rep(label.col,length=n) , # -------- vertex label border ------------------------------ label.border=if(is.character(label.border)&&(length(label.border)==1)){ temp<-label.border label.border <- rep(get.vertex.attribute(x,label.border),length=n) if(all(is.na(label.border))) label.border <- rep(temp,length=n) #Assume it was a color word else{ if(!all(is.color(label.border),na.rm=TRUE)) label.border<-as.color(label.border) } }else{ label.border <- rep(label.border,length=n) } , # ------- vertex label border background color ---------------- label.bg=if(is.character(label.bg)&&(length(label.bg)==1)){ temp<-label.bg label.bg <- rep(get.vertex.attribute(x,label.bg),length=n) if(all(is.na(label.bg))) label.bg <- rep(temp,length=n) #Assume it was a color word else{ if(!all(is.color(label.bg),na.rm=TRUE)) label.bg<-as.color(label.bg) } }else{ label.bg <- rep(label.bg,length=n) } , # ------ Edge color--------- edge.col=if(length(dim(edge.col))==2) #Coerce edge.col/edge.lty to vector form edge.col<-edge.col[d[,1:2]] else if(is.character(edge.col)&&(length(edge.col)==1)){ temp<-edge.col edge.col<-x%e%edge.col if(!is.null(edge.col)){ edge.col<-edge.col[edgetouse] if(!all(is.color(edge.col),na.rm=TRUE)) edge.col<-as.color(edge.col) }else{ edge.col<-rep(temp,length=nE) #Assume it was a color word } }else{ edge.col<-rep(edge.col,length=nE) } , # ----------- Edge line type ------------------ edge.lty=if(length(dim(edge.lty))==2){ edge.lty<-edge.lty[d[,1:2]] }else if(is.character(edge.lty)&&(length(edge.lty)==1)){ temp<-edge.lty edge.lty<-(x%e%edge.lty)[edgetouse] if(all(is.na(edge.lty))) stop("Attribute '",temp,"' had illegal missing values for edge.lty or was not present in plot.network.default.") }else{ edge.lty<-rep(edge.lty,length=nE) } , # ----------- Edge line width ------ edge.lwd=if(length(dim(edge.lwd))==2){ edge.lwd<-edge.lwd[d[,1:2]] # what is going on here? aren't these the incident vertices? # for later matrix lookup? }else if(is.character(edge.lwd)&&(length(edge.lwd)==1)){ temp<-edge.lwd edge.lwd<-(x%e%edge.lwd)[edgetouse] if(all(is.na(edge.lwd))){ stop("Attribute '",temp,"' had illegal missing values for edge.lwd or was not present in plot.network.default.") } }else{ if(length(edge.lwd)==1){ # if lwd has only one element.. if(edge.lwd>0){ # ... and that element > 0 ,use it as a scale factor for the edge values in d # .. unless d is missing if (!is.null(d)){ edge.lwd<-edge.lwd*d[,3] } else { # d is missing, so just replicate edge.lwd<-rep(edge.lwd,length=nE) } }else{ # edge is zero or less, so set it to 1 edge.lwd<-rep(1,length=nE) } } else { # just replacte for the number of edges edge.lwd<-rep(edge.lwd,length=nE) } } , # ----------- Edge curve--------------- edge.curve=if(!is.null(edge.curve)){ if(length(dim(edge.curve))==2){ edge.curve<-edge.curve[d[,1:2]] e.curv.as.mult<-FALSE }else{ if(length(edge.curve)==1){ e.curv.as.mult<-TRUE }else{ e.curv.as.mult<-FALSE } edge.curve<-rep(edge.curve,length=nE) } }else if(is.character(edge.curve)&&(length(edge.curve)==1)){ temp<-edge.curve edge.curve<-(x%e%edge.curve)[edgetouse] if(all(is.na(edge.curve))){ stop("Attribute '",temp,"' had illegal missing values for edge.curve or was not present in plot.network.default.") } e.curv.as.mult<-FALSE }else{ edge.curve<-rep(0,length=nE) e.curv.as.mult<-FALSE } , # -------- edge label ---------------------- edge.label=if(length(dim(edge.label))==2){ #Coerce edge.label to vector form edge.label<-edge.label[d[,1:2]] }else if(is.character(edge.label)&&(length(edge.label)==1)){ temp<-edge.label edge.label<-x%e%edge.label if(!is.null(edge.label)){ edge.label<-edge.label[edgetouse] }else edge.label<-rep(temp,length=nE) #Assume it was a value to replicate }else if(is.logical(edge.label)&&(length(edge.label)==1)) { if (edge.label){ # default to edge ids. edge.label<-valid.eids(x)[edgetouse] } else { # don't draw edge labels if set to FALSE edge.label<-NULL } }else{ # do nothing and hope for the best! edge.label<-rep(edge.label,length=nE) } , # ------ edge label color -------------------- #Edge label color edge.label.col=if(length(dim(edge.label.col))==2){ #Coerce edge.label.col edge.label.col<-edge.label.col[d[,1:2]] } else if(is.character(edge.label.col)&&(length(edge.label.col)==1)){ temp<-edge.label.col edge.label.col<-x%e%edge.label.col if(!is.null(edge.label.col)){ edge.label.col<-edge.label.col[edgetouse] if(!all(is.color(edge.label.col),na.rm=TRUE)) edge.label.col<-as.color(edge.label.col) }else edge.label.col<-rep(temp,length=nE) #Assume it was a color word }else{ edge.label.col<-rep(edge.label.col,length=nE) } , # ------- edge.label.cex -------------------- #Edge label cex edge.label.cex=if(length(dim(edge.label.cex))==2) edge.label.cex<-edge.label.cex[d[,1:2]] else if(is.character(edge.label.cex)&&(length(edge.label.cex)==1)){ temp<-edge.label.cex edge.label.cex<-(x%e%edge.label.cex)[edgetouse] if(all(is.na(edge.label.cex))) stop("Attribute '",temp,"' had illegal missing values for edge.label.cex or was not present in plot.network.default.") }else{ edge.label.cex<-rep(edge.label.cex,length=nE) } # case in which none of the argument names match up # stop('argument "',argName,'"" does not match with any of the plot.network arguments') # can't error out, because this function will be called with non-network args, so just # return the value passed in ) # end switch block # now return the checked / expanded value return(get(argName)) } network/R/assignment.R0000644000176200001440000000405513650470664014456 0ustar liggesusers###################################################################### # # assignment.R # # Written by Carter T. Butts ; portions contributed by # David Hunter and Mark S. Handcock # . # # Last Modified 11/26/19 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains various routines for the assignment of network objects # into calling environments. These are internal functions and not to be used # by the package users. # # Contents: # # .findNameInSubsetExpr # .validLHS # ###################################################################### # Recursively traverse the parse tree of the expression x, ensuring that it is # a valid subset expresssion, and return the name associated with the expression. # .findNameInSubsetExpr <- function(x){ if (inherits(x,'call')){ # Ensure call is a subset function, one of $, [, or [[ if(!(deparse(x[[1]]) %in% c('$','[','[['))) return(NA) # Make sure arguments are clean xns <- lapply(x[2:length(x)],.findNameInSubsetExpr) if (any(is.na(xns))) return(NA) # Possible name found return(xns[[1]]) } else if (inherits(x,'name')) return(deparse(x)) NULL } # Return TRUE if x is a valid left-hand-side object that can take a value .validLHS <- function(x,ev){ xn <- .findNameInSubsetExpr(x) # There are valid expressions for which we don't want to assign into the caller's env. # For instance, when a user executes z<-add.edges(x+y), then the user obviously # doesn't want x+y to be assigned. Rather he's using them as temporaries to obtain # z. OTOH we don't want someone doing something obtuse like add.edges(x[sample(...)]) # In the first case, it's not wrong to end up here, but in the second case we would # like to warn the user. But we're not going to at this point. #warning('Cannot make assignment into ',deparse(x)) if (!is.null(xn) && !is.na(xn) && exists(xn,envir=ev)) return(TRUE) else return(FALSE) } network/MD50000644000176200001440000001315514061574702012266 0ustar liggesusers9b699d8131bbe4e391b88e47beef1f74 *COPYING 4445977820f5da902fd0a4c4d1116598 *ChangeLog daa20218cdc5e1b7715d8d4774a5be2c *DESCRIPTION 3bc0cb2dfb5b191050fbb5152fecab32 *NAMESPACE 7711f469e7a1dddd34cf21213ab0a80b *R/access.R 63f6b1ad54197f31866586e7a7608a80 *R/as.edgelist.R 1589770cd6defbc3704ee0d2f9b1cfe4 *R/assignment.R e3ce4e631686247b0ae77c2a2b54b0eb *R/coercion.R 54f51b3a32ed37c00b4a10bec56d188b *R/constructors.R 31b452422a0a81a556c5c29f1d28eb3e *R/dataframe.R a3c8acb01326737491cf117e4389d3ad *R/fileio.R e4bb97ca8d816a7c6c9682d252f4736c *R/layout.R e35133a9713f7eedfb00918942d3fec7 *R/misc.R 724d453b2daf5820746f84caf5558458 *R/network-package.R c4658fde4681ba26f7caf5cf75ed743e *R/operators.R 8f3562233a57cde358e6b400ca2959f6 *R/plot.R c32f1c0c9fcaa343a872dd12ee309c8c *R/printsum.R 263822ebe70c081f9b90a05790829538 *R/zzz.R 760d0b3e456c966376e0d18c7213e600 *README.md 5883b31f7d1b112845bc08d9f4eb36cd *build/vignette.rds 4e1fd0dcead8991dc32c05e2d7301c40 *data/emon.RData bb3e0d4d549b892aa8701af630adb78a *data/flo.RData 312b290fd4e326cd5147d7f293728109 *inst/CITATION 3e06997d5f02a81dfdccf3d00ff43d0f *inst/doc/networkVignette.R e426433ac42ea149a73be4923359cf0d *inst/doc/networkVignette.Rnw ac4f30911cef25b613ef27d546427f7e *inst/doc/networkVignette.pdf 2fce00a65f9969063ffe26e50ccbd87c *inst/include/netregistration.h 4b9aa09dd1d9f3ff6e9cd5236188d653 *inst/include/network.h c78b6af71f6256929251472b1d75fbe1 *inst/network.api/networkapi.c 1c85daf92af86106d5fb3e0797eda213 *inst/network.api/networkapi.h 856af12a5d27abbbb0d9e90ece504486 *man/add.edges.Rd 970966dfd9c04a965cf2e3a1c15b867c *man/add.vertices.Rd 050041ed9630847918d1f5aef7bb559a *man/as.color.Rd 527bec4496a2890641b69f4aadc5900d *man/as.data.frame.network.Rd ba90af3e510e8d2ed100492a668db41a *man/as.edgelist.Rd f162a5a390b318a71ef4d9c21c81fa27 *man/as.matrix.network.Rd 5f3eca6afe2d4bfba4a143b1d6d59f32 *man/as.network.matrix.Rd e7233734deb578bffa164eb8a6861525 *man/as.sociomatrix.Rd 67231e66a81c5bb9f5f11b5c56e93659 *man/attribute.methods.Rd e19ceb26621876cf66284bfebd51bd41 *man/deletion.methods.Rd 98d1103079c7e6cb4bd2bd7033d1345b *man/edgeset.constructors.Rd 49bf9f0e4d8ab192a342caa561136a80 *man/emon.Rd ceec9dfc3b6392adf7a859e7fae9bdec *man/flo.Rd 458c4bfb9c7af0365a6e6713e965c647 *man/get.edges.Rd 635ac2ee6054f46b5f04940af7be8209 *man/get.inducedSubgraph.Rd 925ede0dd14067eded687953250e4693 *man/get.neighborhood.Rd 531bf734d867ce44efcf534a16416d31 *man/has.edges.Rd 0646e1ccbc345eb32b187c7a8659c804 *man/is.adjacent.Rd 3c72a55e72fdbb21dbf618aacff1e432 *man/loading.attributes.Rd f777f59c54627809aa77690959b60252 *man/mixingmatrix.Rd fdefba72e6a1c0e37a3ae45d6a645b36 *man/network-internal.Rd a0d15078aad89b9b1065412b718894a9 *man/network-operators.Rd 49e60c11289ff2d5a295d321c15014e5 *man/network-package.Rd 6f812eea36d010190f623b6b4389b2f8 *man/network.Rd a379cd52ad971bcf648cee5d3d8f01f6 *man/network.arrow.Rd 813cf279600cf2805d950b379f495619 *man/network.density.Rd ec7d73f902cfcc1e7e12dfb440e41a82 *man/network.dyadcount.Rd f810eeeac9046c3a5241b4439817cc30 *man/network.edgecount.Rd 436db36c5955e9f78d3aa2a94bc85b39 *man/network.edgelabel.Rd 5893d9003882e4d4c8fb4254bdd3e73d *man/network.extraction.Rd 43eb5a18f9bb73e0051b9cd74fa24554 *man/network.indicators.Rd dd59a5b629f7f37a9651e3a2d2182c26 *man/network.initialize.Rd 48a03a236d245643e9dfcca016c3efc9 *man/network.layout.Rd eca169ee58fa0c8719bc057641d0d21c *man/network.loop.Rd 3ec523244519270feb2d30cfaea7d7e0 *man/network.naedgecount.Rd 71c909ccd40c8c838b5911d85ea3e186 *man/network.size.Rd ae378875f37ee6d12b5ca07577777088 *man/network.vertex.Rd 92a0e855f4f37a712c5707fb3c3a1c7b *man/permute.vertexIDs.Rd b1d33cbeb8bfd1b154b0f03903b977b0 *man/plot.network.Rd 0a6ddb702f25ad304107148b72b7ddd1 *man/preparePlotArgs.Rd 2b3967ff89ccb14c161d54229a9d5b88 *man/prod.network.Rd dc4b9d73c25b3112155ce8a768e45c9c *man/read.paj.Rd 24589f1d9795af2a05a2a73b7b130f66 *man/sum.network.Rd 8926a43323843bdd67367123a446f9f5 *man/valid.eids.Rd b9891aea2f463206f7c3f10750bf3b58 *man/which.matrix.type.Rd 1c5cf8036602f903a2699b928fc0ca93 *src/Rinit.c 2548f7df470271b44d105128264e8141 *src/access.c 96fc95a8ae2941d6e411b38c80cee9af *src/access.h 739756cc9b67f775864fa7f6aa19745e *src/constructors.c 58ac8ab29e39950e95390b86a5de4c83 *src/constructors.h 99ad146ab20fdd5dd38725385c7f2dda *src/layout.c c929fe23f5a09c76c8c11aa83dbb2ed1 *src/layout.h c624cbb55190d144a79c1fea041fab68 *src/utils.c b5ed5be00b1bddd126b1bd7e4937ee3f *src/utils.h 59fde81bf25fff109743e99b70fbdc4f *tests/benchmarks 0a23d7f3f59fcc13ef07af938e3cf7e2 *tests/general.tests.R f01bd5b7ac70071da9be771abba2d154 *tests/general.tests2.R bd96d1aa7245a80f1e03167c2c66e9a3 *tests/list.attribute.tests.R a355b97158d2ad9a1b0800f793149be1 *tests/network.access.test.R 9eae5b93f6faa6f46256733ca7224cce *tests/network.battery.R 425abb6755bec5df58bd60210b140ddf *tests/pathological.tests.R 845a2f93c870d775c78ddc3a90cfda0b *tests/plotflo.R 53a55610f3c4696f58fb967b8b82728c *tests/speedTests.R b2c97b33a2d412dc5d5e11f14b3c4e6f *tests/testthat.R 5ab849d6dbce7859c13f9a9cef1aa768 *tests/testthat/test-as.edgelist.R 413c3473ab776e159f46ba7c7d81f09b *tests/testthat/test-dataframe.R 87cfdbb310dad8da648dc6433d58b2a1 *tests/testthat/test-i22-summary-character.R 52da4d470df06df454cbc61ac1842807 *tests/testthat/test-indexing.R 93c5263fc884f28035b4a626f25cadf3 *tests/testthat/test-misc_tests.R 0e4bed5f2503c875e914efb4bb1b702a *tests/testthat/test-mixingmatrix.R b23e027276cda9c47b82452cf39cd5c1 *tests/testthat/test-networks.R 8514de6d9548451f179969d8e8f29c82 *tests/testthat/test-plot.R b8de12e77f58a3c6570391ee5c7116e9 *tests/testthat/test-read.paj.R ada28de34c8d472fc95aa852611895b6 *tests/vignette.R e426433ac42ea149a73be4923359cf0d *vignettes/networkVignette.Rnw network/inst/0000755000176200001440000000000014061532363012723 5ustar liggesusersnetwork/inst/network.api/0000755000176200001440000000000013357022000015151 5ustar liggesusersnetwork/inst/network.api/networkapi.c0000644000176200001440000000617113656361200017517 0ustar liggesusers/* ###################################################################### # # networkapi.c # # Written by Carter T. Butts # Last Modified 5/07/16 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater. # # Provides support for the R/network package API. # # This file is known to be compatible with network package version 1.14. # It should be compatible with subsequent versions, but updates may be # necessary in rare cases. # # This file contains the registration routine needed to use the # C-level network package API. # ###################################################################### */ /*INCLUSIONS----------------------------------------------------------------*/ #include #include #include "networkapi.h" /*INTERNAL FUNCTIONS--------------------------------------------------------*/ void netRegisterFunctions(void) /*Register functions for the network package API. This function must be called before using any API routines, since these routines will not otherwise be defined within the local namespace.*/ { /*Register access routines*/ netGetEdgeAttrib_ptr = (SEXP (*)(SEXP, int, const char*)) R_GetCCallable("network", "getEdgeAttribute"); netGetEdgeIDs_ptr = (SEXP (*)(SEXP, int, int, const char*, int)) R_GetCCallable("network", "getEdgeIDs"); netGetEdges_ptr = (SEXP (*)(SEXP, int, int, const char*, int)) R_GetCCallable("network", "getEdges"); netGetNeighborhood_ptr = (SEXP (*)(SEXP, int, const char*, int)) R_GetCCallable("network", "getNeighborhood"); netGetNetAttrib_ptr = (SEXP (*)(SEXP, const char*)) R_GetCCallable("network", "getNetworkAttribute"); netHasLoops_ptr = (int (*)(SEXP)) R_GetCCallable("network", "hasLoops"); netIsAdj_ptr = (int (*)(SEXP, int, int, int)) R_GetCCallable("network", "isAdjacent"); netIsDir_ptr = (int (*)(SEXP)) R_GetCCallable("network", "isDirected"); netIsHyper_ptr = (int (*)(SEXP)) R_GetCCallable("network", "isHyper"); netIsLoop_ptr = (int (*)(SEXP, SEXP)) R_GetCCallable("network", "isLoop"); netIsMulti_ptr = (int (*)(SEXP)) R_GetCCallable("network", "isMultiplex"); netIsNetwork_ptr = (int (*)(SEXP)) R_GetCCallable("network", "isNetwork"); netNetEdgecount_ptr = (int (*)(SEXP, int)) R_GetCCallable("network", "networkEdgecount"); netNetSize_ptr = (int (*)(SEXP)) R_GetCCallable("network", "networkSize"); /*Register modification routines*/ netAddEdge_ptr = (SEXP (*)(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP)) R_GetCCallable("network", "addEdge_R"); netAddEdges_ptr = (SEXP (*)(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP)) R_GetCCallable("network", "addEdges_R"); netDelEdgeAttrib_ptr = (SEXP (*)(SEXP, int, const char*)) R_GetCCallable("network", "deleteEdgeAttribute"); netDelVertexAttrib_ptr = (SEXP (*)(SEXP, int, const char*)) R_GetCCallable("network", "deleteVertexAttribute"); netDelNetAttrib_ptr = (SEXP (*)(SEXP, const char*)) R_GetCCallable("network", "deleteNetworkAttribute"); netSetNetAttrib_ptr = (SEXP (*)(SEXP, const char*, SEXP)) R_GetCCallable("network", "setNetworkAttribute"); netSetVertexAttrib_ptr = (SEXP (*)(SEXP, const char*, SEXP, int)) R_GetCCallable("network", "setVertexAttribute"); network/inst/network.api/networkapi.h0000644000176200001440000000602213656361215017525 0ustar liggesusers/* ###################################################################### # # networkapi.h # # Written by Carter T. Butts # Last Modified 5/07/16 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater. # # Provides support for the R/network package API. # # This file was written for network version 1.14. If using a later # version of network, you may need to update it. # # This file contains headers for networkapi.c, as well as macros and # other definitions needed to support the network package API. # ###################################################################### */ #ifndef NETWORKAPI_H #define NETWORKAPI_H /*INCLUSIONS----------------------------------------------------------------*/ #include #include #include #include /*FUNCTION MACROS-----------------------------------------------------------*/ /*Access functions*/ #define netGetEdgeAttrib (*netGetEdgeAttrib_ptr) #define netGetEdgeIDs (*netGetEdgeIDs_ptr) #define netGetEdges (*netGetEdges_ptr) #define netGetNeighborhood (*netGetNeighborhood_ptr) #define netGetNetAttrib (*netGetNetAttrib_ptr) #define netHasLoops (*netHasLoops_ptr) #define netIsAdj (*netIsAdj_ptr) #define netIsDir (*netIsDir_ptr) #define netIsHyper (*netIsHyper_ptr) #define netIsLoop (*netIsLoop_ptr) #define netIsMulti (*netIsMulti_ptr) #define netIsNetwork (*netIsNetwork_ptr) #define netNetEdgecount (*netNetEdgecount_ptr) #define netNetSize (*netNetSize_ptr) /*Modification functions*/ #define netAddEdge (*netAddEdge_ptr) #define netAddEdges (*netAddEdges_ptr) #define netDelEdgeAttrib (*netDelEdgeAttrib_ptr) #define netDelNetAttrib (*netDelNetAttrib_ptr) #define netDelVertexAttrib (*netDelVertexAttrib_ptr) #define netSetNetAttrib (*netSetNetAttrib_ptr) #define netSetVertexAttrib (*netSetVertexAttrib_ptr) /*POINTER VARIABLES---------------------------------------------------------*/ /*Access functions*/ SEXP (*netGetEdgeAttrib_ptr)(SEXP, int, const char*); SEXP (*netGetEdgeIDs_ptr)(SEXP, int, int, const char*, int); SEXP (*netGetEdges_ptr)(SEXP, int, int, const char*, int); SEXP (*netGetNeighborhood_ptr)(SEXP, int, const char*, int); SEXP (*netGetNetAttrib_ptr)(SEXP, const char*); int (*netHasLoops_ptr)(SEXP); int (*netIsAdj_ptr)(SEXP, int, int, int); int (*netIsDir_ptr)(SEXP); int (*netIsHyper_ptr)(SEXP); int (*netIsLoop_ptr)(SEXP, SEXP); int (*netIsMulti_ptr)(SEXP); int (*netIsNetwork_ptr)(SEXP); int (*netNetEdgecount_ptr)(SEXP, int); int (*netNetSize_ptr)(SEXP); /*Modification functions*/ SEXP (*netAddEdge_ptr)(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); SEXP (*netAddEdges_ptr)(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); SEXP (*netDelEdgeAttrib_ptr)(SEXP, int, const char*); SEXP (*netDelNetAttrib_ptr)(SEXP, const char*); SEXP (*netDelVertexAttrib_ptr)(SEXP, int, const char*); SEXP (*netSetNetAttrib_ptr)(SEXP, const char*, SEXP); SEXP (*netSetVertexAttrib_ptr)(SEXP, const char*, SEXP, int); /*REGISTRATION FUNCTIONS----------------------------------------------------*/ void netRegisterFunctions(void); #endif network/inst/doc/0000755000176200001440000000000014061532363013470 5ustar liggesusersnetwork/inst/doc/networkVignette.Rnw0000644000176200001440000023443013357022000017352 0ustar liggesusers\documentclass[article,shortnames,nojss]{jss} %\documentclass{article} \usepackage{amsfonts,amssymb,amsthm,amsmath,rotating} %\usepackage{natbib} %for easy biblo %\usepackage{hyperref} %for url links %\usepackage{comment} %\usepackage{color} %\VignetteIndexEntry{network Vignette} \author{Carter T.\ Butts\\ University of California, Irvine} \Plainauthor{Carter T. Butts} \title{\pkg{network}: A Package for Managing Relational Data in \proglang{R}} \Plaintitle{network: A Package for Managing Relational Data in R} \Shorttitle{\pkg{network}: Managing Relational Data in \proglang{R}} \Abstract{ Effective memory structures for relational data within \proglang{R} must be capable of representing a wide range of data while keeping overhead to a minimum. The \pkg{network} package provides an class which may be used for encoding complex relational structures composed a vertex set together with any combination of undirected/directed, valued/unvalued, dyadic/hyper, and single/multiple edges; storage requirements are on the order of the number of edges involved. Some simple constructor, interface, and visualization functions are provided, as well as a set of operators to facilitate employment by end users. The package also supports a \proglang{C}-language API, which allows developers to work directly with \pkg{network} objects within backend code.} \Keywords{relational data, data structures, graphs, \pkg{network}, \pkg{statnet}, \proglang{R}} \Plainkeywords{relational data, data structures, graphs, network, statnet, R} \Volume{24} \Issue{2} \Month{February} \Year{2008} \Submitdate{2007-06-01} \Acceptdate{2007-12-25} \Address{ Carter T.\ Butts\\ Department of Sociology and Institute for Mathematical Behavioral Sciences\\ University of California, Irvine\\ Irvine, CA 92697-5100, United States of America\\ E-mail: \email{buttsc@uci.edu}\\ URL: \url{http://www.faculty.uci.edu/profile.cfm?faculty_id=5057} } \begin{document} \definecolor{Sinput}{rgb}{0.19,0.19,0.75} \definecolor{Soutput}{rgb}{0.2,0.3,0.2} \definecolor{Scode}{rgb}{0.75,0.19,0.19} \DefineVerbatimEnvironment{Sinput}{Verbatim}{formatcom = {\color{Sinput}}} \DefineVerbatimEnvironment{Soutput}{Verbatim}{formatcom = {\color{Soutput}}} \DefineVerbatimEnvironment{Scode}{Verbatim}{formatcom = {\color{Scode}}} \renewenvironment{Schunk}{}{} \SweaveOpts{concordance=TRUE} PLEASE NOTE: This document has been modified from the original paper to form a package vignette. It has been compiled with the version of the network package it is bundled with, and has been partially updated to reflect some changes in the package. The original paper is:\\ \pkg{network}: A Package for Managing Relational Data in \proglang{R}. \emph{Journal of Statistical Software} 24:2, 2008. \url{http://www.jstatsoft.org/v24/i02/paper} \section{Background and introduction} In early 2002, the author and several other members of what would ultimately become the \pkg{statnet} project \citep{statnet} came to the conclusion that the simple, matrix-based approach to representation of relational data utilized by early versions of packages such as \pkg{sna} were inadequate for the next generation of relational analysis tools in \proglang{R}. Rather, what was required was a customized class structure to support relational data. This class structure would be used for all \pkg{statnet} packages, thus insuring interoperability; ideally, it would also be possible to port this structure to other languages, thereby further enhancing compatibility. The requirements which were posed for a network data class were as follows, in descending order of priority: \begin{enumerate} \item The class had to be sufficiently general to encode all major types of network data collected presently or in the foreseeable future; \item Class storage needed to be of sufficient efficiency to permit representation of large networks (in particular, storage which was sub-quadratic in graph order for sparse networks); and \item It had to be possible to develop interface methods to the class which were of reasonable computational efficiency. \end{enumerate} Clearly, there are multiple approaches which could be taken to construct such a class structure. Here we describe the result of one particular effort, specifically the \pkg{network} package \citep{network} for the \proglang{R} system for statistical computing \citep{R}. \subsection{Historical note} The \pkg{network} package as described here evolved from a specification originally written as an unpublished working paper, ``Memory Structures for Relational Data in \proglang{R}: Classes and Interfaces'' \citep{butts:tr:2002}. At this time, the class in question was tentatively entitled ``graph.'' It subsequently emerged that a similar package was being developed by Robert Gentleman under the \pkg{graph} title (as part of the BioConductor project) \citep{gentleman.et.al:sw:2007}, and the name of the present project was hence changed to ``network'' in early 2005. A somewhat later version of the above relational data specification was also shared with Gabor Csardi in mid-2004, portions of which were incorporated in the development by Gabor of the \pkg{igraph} package \citep{gabor:sw:2007}. As a result, there are currently three commonly available class systems for relational data in \proglang{R}, two of which (\pkg{network} and \pkg{igraph}) share some common syntax and interface concepts. It should also be noted that (as mentioned above) both standard and sparse matrix \citep[e.g., \pkg{sparseM}][]{koenker.ng:sw:2007} classes have been and continue to be used to represent relational data in \proglang{R}. This article does not attempt to address the relative benefits and drawbacks of these different tools, but readers should be aware that multiple alternatives are available. \subsection{A very quick note on notation} Throughout this paper we will use ``graph'' or ``network'' ($G$) generically to refer to any relational structure on a given vertex set ($V$), and ``edge'' to refer to a generalized edge (i.e., an ordered pair $(T,H)$ where $T$ is the ``tail set'' of the edge and $H$ is the corresponding ``head set,'' and where $T,H \subseteq V(G)$). The cardinality of the vertex set we denote $|V(G)|=n$, and the cardinality of the corresponding edge set we likewise denote $|E(G)|=m$. When discussing storage/computational complexity we will often use a loose order notation, where $\mathcal{O}\bigl(f\left(x\right)\bigr)$ is intended to indicate that the quantity in question grows more slowly than $f(x)$ as $x \to \infty$. A general familiarity with the \proglang{R} statistical computing system (and related syntax/terminology) is assumed. Those unfamiliar with \proglang{R} may wish to peruse a text such as those of \citet{venables.ripley:bk:2000,venables.ripley:bk:2002} or \citet{chambers:bk:1998}. \section[The network class]{The \code{network} class} The \code{network} class is a (reasonably) simple object structure designed to store a single relation on a vertex set of arbitrary size. The relation stored by a \code{network} class object is based on a generalized edge model; thus, edges may be directed, arbitrarily valued (with multiple values per edge), multiplex (i.e., multiple edges per directed dyad), hyper (i.e., multiple head/tail vertices per edge), etc. Storage requirements for the \code{network} class are on the order of the number of nodes plus the total number of edges (which is substantially sub-$n^2$ for sparse graphs), and retrieval of edge values has a time complexity which is no worse than $\mathcal{O}(n)$.\footnote{Edge retrieval actually scales with degree, and average retrieval time is hence approximately constant for many data sources. For an argument regarding constraints on the growth of mean degree in interpersonal networks, see e.g., \citet{mayhew.levinger:ajs:1976}.} For example, a network with 100,000 vertices and 100,000 edges currently consumes approximately 74MB of RAM (\proglang{R} 2.6.1), versus approximately 40GB for a full sociomatrix (a savings of approximately 99.8\%). When dealing with extremely large, sparse graphs it therefore follows that \code{network} objects are substantially more efficient than simpler representations such as adjacency matrices. The class also provides for the storage of arbitrary metadata at the edge, vertex, and network level. Thus, \code{network} objects may be preferred to matrix representations for reasons of generality, performance, or integrative capability; while alternative means exist of obtaining these goals separately, \pkg{network} provides a single toolkit which is designed to be effective across a wide range of applications. In this section, we provide a basic introduction to the \code{network} class, from a user's point of view. We describe the conditions which are necessary for \pkg{network} to be employed, and the properties of \code{network} objects (and their components). This serves as background for a discussion of the use of \pkg{network} methods in practical settings, which is given in the section which follows. \subsection{Identification of vertices and edges} For purposes of storage, we presume that each vertex and each edge can be uniquely identified. \citep[For partially labeled or unlabeled graphs, observe that this internal labeling is essentially arbitrary. See][for a discussion.]{butts.carley:cmot:2005} Vertices are labeled by positive integers in the order of entry, with edges likewise; it is further assumed that this is maintained for vertices (e.g., removing a vertex requires relabeling) but not for edges. (This last has to do with how edges are handled internally, but has the desirable side effect of making edge changes less expensive.) Vertices and edges are always stored by label. In the text that follows, any reference to a vertex or edge ``ID'' refers to these labeling numbers, and not to any other (external) identification that a vertex or edge may have. \subsection{Basic class structure} Functionally, a \code{network} object can be thought as a collection of vertices and edges, together with metadata regarding those vertices and edges (as well as the network itself). As noted above, each vertex is assumed to be identifiable, and the number of vertices is fixed. Here, we discuss the way in which edges are defined within \pkg{network}, as well as the manner in which associated metadata is stored. \subsubsection{Edge structure} Edges within a \code{network} object consist of three essential components. First, each edge contains two vectors of vertex IDs, known respectively as the \emph{head} and \emph{tail} lists of the edge. In addition to these lists, each edge also contains a list of attribute information. This is discussed in more detail below. The content and interpretation of the head and tail lists are dependent on the type of network in which they reside. In a directed network, an edge connects the elements of its tail list with those of its head list, but not vice versa: $i$ is adjacent to $j$ iff there exists some edge, $e=(T,H)$, such that $i\in T, j\in H$. In an undirected network, by contrast, the head and tail sets of an edge are regarded as exchangeable. Thus, $i$ is adjacent to $j$ in an undirected network iff there exists an edge such that $i\in T, j\in H$ or $i\in H, j\in T$. \pkg{network} methods which deal with adjacency and incidence make this distinction transparently, based on the network object's directedness attribute (see below). Note that in the familiar case of dyadic networks (the focus of packages such as \pkg{sna} \citep{sna}), the head and tail lists of any given edge must have exactly one element. This need not be true in general, however. An edge with a head or tail list containing more than one element is said to be \emph{hypergraphic}, reflecting a one-to-many, many-to-one, or many-to-many relationship. Hyperedges are permitted natively within \pkg{network}, although some methods may not support them -- a corresponding network attribute is used by \pkg{network} methods to determine whether these edges are present, as explained below. Finally, another fundamental distinction is made between edges in which $H$ and $T$ are disjoint, versus those in which these endpoint lists have one or more elements in common. Edges of the latter type are said to be \emph{loop-like}, generalizing the familiar notion of ``loop'' (self-tie) from the theory of dyadic graphs. Loop-like edges allow vertices to relate to themselves, and are disallowed in many applications. Applicable methods are expected to interpret such edges intelligently, where present. \subsubsection[network attributes]{\code{network} attributes} \label{sec_net_attr} As we have already seen, each \code{network} object contains a range of metadata in addition to relational information. This metadata -- in the form of attributes -- is divided into information stored at the network, vertex, and edge levels. In all three cases, attributes are stored in \code{list}s, and are expected to be named. While there is no limit to the user-defined attributes which may be stored in this manner, certain attributes are required of all \code{network} objects. At the network level, such attributes describe general properties of the network as a whole; specifically, they may be enumerated as follows: \begin{description} \item[\code{bipartite}] This is a \code{logical} or \code{numeric} attribute, which is used to indicate the presence of an intrinsic bipartition in the \code{network} object. Formally, a bipartition is a partition of a network's vertices into two classes, such that no vertex in either class is adjacent to any vertex in the same class. While such partitions occur naturally, they may also be specifically enforced by the nature of the data in question. (This is the case, for instance, with two-mode networks \citep{wass:faus1994}, in which edges represent connections between two distinct classes of entities.) In order to allow for bipartite networks with a partition size of zero, non-bipartite networks are marked as \code{bipartite=FALSE}. Where the value of \code{bipartite} is numeric, \pkg{network} methods will automatically assume that vertices with IDs less than or equal to \code{bipartite} belong to one such class, with those with IDs greater than \code{bipartite} belonging to the other. This information may be used in selecting default modes for data display, calculating numbers of possible edges, etc. When \code{bipartite == FALSE} or {NULL}, by contrast, no such bipartition is assumed. Because of the dual \code{logical}/\code{numeric} nature of the attribute, it is safest to check it using the \code{is.bipartite} method. It should be emphasized that \code{bipartite} is intended to reflect bipartitions which are required \emph{ex ante,} rather than those which happen to arise empirically. There is also no performance advantage to the use of \code{bipartite}, since \pkg{network} only stores edges which are defined; it can make data processing more convenient, however, when working with intrinsically bipartite structures. \item[\code{directed}] This is a \code{logical} attribute, which should be set to \code{TRUE} iff edges are to be interpreted as directed. As explained earlier, \pkg{network} methods will regard edge endpoint lists as exchangeable when \code{directed} is \code{FALSE}, allowing for automatic handling of both directed and undirected networks. For obvious reasons, misspecification of this attribute may lead to surprising results; it is generally set when a \code{network} object is created, and considered fixed thereafter. \item[\code{hyper}] This attribute is a \code{logical} variable which is set to \code{TRUE} iff the network is allowed to contain hyperedges. Since the vast majority of network data is dyadic, this attribute defaults to \code{FALSE} for must construction methods. The setting of \code{hyper} to \code{TRUE} has potentially serious implications for edge retrieval, and so methods should not activate this option unless hypergraphic edges are explicitly to be permitted. \item[\code{loops}] As noted, loop-like edges are frequently undefined in practical settings. The \code{loops} attribute is a \code{logical} which should be set to \code{TRUE} iff such edges are permitted within the network. \item[\code{multiple}] In most settings, an edge is uniquely defined by its head and tail lists. In other cases, however, one must represent data in which multiple edges are permitted between the same endpoints. (``Same'' here includes the effect of directedness; an edge from set $H$ to set $T$ is not the same as an edge from set $T$ to set $H$, unless the network is undirected.) The \code{multiple} attribute is a \code{logical} variable which is set to \code{TRUE} iff such multiplex edges are permitted within the network. Where \code{multiple} is \code{FALSE}, \pkg{network} methods will assume all edges to be unique -- like \code{directed}, the possibility of multiplex edges thus can substantially impact both behavior and performance. For this reason, \code{multiple} is generally set to \code{FALSE} by default, and should not be set to \code{TRUE} unless it is specifically necessary to permit multiple edges between the same endpoint sets. \item[\code{n}] Finally, \code{n} is a \code{numeric} attribute containing the number of elements in the vertex set. Applicable methods are expected to adjust this attribute up or down, should vertices be added or deleted from the network. Note that as of \pkg{network} v1.8, networks of size zero are permitted. \end{description} While these attributes are clearly reserved, any number of others may be added. Attributes specifically pertaining to edges and/or vertices can be stored at the network level, but this is generally non-optimal -- such attributes would have to be manually updated to reflect edge or vertex changes, and would require the creation of custom access methods. The preferred approach is to store such information directly at the edge or vertex level, as we discuss below. \subsubsection[Vertex attributes]{Vertex attributes} As with the network as a whole, it is often useful to be able to supply attribute data for individual vertices (e.g., names, attributes, etc.). Each vertex thus has a \code{list} of named attributes, which can be used to store arbitrary information on a per-vertex basis; there is no restriction on the type of information which may be stored in this fashion, nor are all vertices constrained to carry information regarding the same attributes. Each vertex does carry two special attributes, however, which are assumed to be available to all class methods. These are \code{vertex.names}, which must be a \code{character} containing the name of the vertex, and the \code{logical} attribute \code{na}. Where \code{TRUE}, \code{na} indicates that the associated vertex is unobserved; this is useful in cases for which individual entities are known to belong to a given network, but where data regarding those entities is unavailable. By default, \code{na} is set to \code{FALSE} and \code{vertex.names} is set equal to the corresponding vertex ID. \subsubsection[Edge attributes]{Edge attributes} Just as vertices can carry attributes, so too can edges. Each edge is endowed with a \code{list} of named attributes, which can be used to carry arbitrary information (e.g., tie strength, onset and termination times, etc.). As with vertex attributes, any information type may be employed and there is no requirement that all edges carry the same attributes. The one attribute required to be carried by each edge is \code{na}, a \code{logical} which (like the vertex case) is used to indicate the missingness of a given edge. Many \pkg{network} methods provide the option of filtering out missing edges when retrieving information, and/or returning the associated information (e.g., adjacency) as missing. \section[Using the network class]{Using the \code{network} class} In addition to the class itself, \pkg{network} provides a range of tools for creating, manipulating, and visualizing \code{network} objects.\footnote{These tools are currently implemented via S3 methods.} Here, we provide an overview of some of these tools, with a focus on the basic tasks most frequently encountered by end users. Additional information on these functions is also provided within the package manual. For the examples below, we begin by loading the network package into memory; we also set the random seed, to ensure that examples using random data match the output shown here. Within \proglang{R}, this may be accomplished via the following: <<>>= library(network) set.seed(1702) @ Throughout, we will represent \proglang{R} code in the above format. Readers may wish to try the demonstrations listed here for themselves, to get a better feel for how the package operates. \subsection{Importing data} It almost goes without saying that an important aspect of \pkg{network} functionality is the ability to import data from external sources. \pkg{network} includes functionality for the importation of \pkg{Pajek} project files \citep{pajek}, a popular and versatile network data format, via the \code{read.paj} routine. Other formats supported by \pkg{sna} can be used as well, by importing to adjacency matrix form (using the relevant \pkg{sna} routines) and then coercing the result into a \code{network} object as described below. The \pkg{foreign} package can be used to import adjacency, edgelist, or incidence matrices from other computing environments in much the same way. Future package versions may include support for converting to and from other related classes, e.g., those of \pkg{RBGL} \citep{carey.et.al:sw:2007} and \pkg{Rgraphviz} \citep{gentry.et.al:sw:2007}. In addition to these methods, \code{network} objects can be loaded into \proglang{R} using native tools such as \code{load} (for saved objects) or \code{data} (for packaged data sets). With respect to the latter, \pkg{network} contains two sample data sets: \code{flo}, John Padgett's Florentine wedding data \citep[from][]{wass:faus1994}; and \code{emon}, a set of interorganizational networks from search and rescue operations collected by \citet{drabek.et.al:bk:1981}. \code{flo} consists of a single adjacency matrix, and is useful for illustrating the process of converting data from adjacency matrix to \code{network} form. \code{emon}, on the other hand, consists of a list of seven \code{network} objects with vertex and edge metadata. \code{emon} is thus especially useful for illustrating the use of \code{network} objects for rich data storage (in addition to being an interesting data set in its own right). Loading these data sets is as simple as invoking the \code{data} command, like so: <<>>= data("flo") data("emon") @ Further information on each of these data sets is given in the \pkg{network} manual. We shall also use these data sets as illustrative examples at various points within this paper. \subsection[Creating and viewing network objects]{Creating and viewing \code{network} objects} While importation is sometimes possible, in other cases we must create our own \code{network} objects. \pkg{network} supports two basic approaches to this task: create the object from scratch, or build it from existing relational data via coercion. Both methods are useful, and we illustrate each here. In the most minimal case, we begin by creating an empty network to which edges may be added. This task is performed by the \code{network.initialize} routine, which serves as a constructor for the \code{network} class. \code{network.initialize} takes the order of the desired graph (i.e., $n$) as a required argument, and the required network attributes discussed in Section~\ref{sec_net_attr} may be passed as well. In the event that these are unspecified, it is assumed that a simple digraph (directed, no loops, hyperedges, multiplexity, or bipartitions) is desired. For example, one may create and print an empty digraph like so: <<>>= net <- network.initialize(5) net @ \pkg{network} has default \code{print} and \code{summary} methods, as well as low-level operators for assignment and related operations. These do not show much in the above case, since the network in question caries little information. To create a \code{network} along with a specified set of edges, the preferred high-level constructor is the eponymous \code{network}. Like \code{network.initialize}, this function returns a newly allocated \code{network} object having specified properties. Unlike the former, however, \code{network} may be called with adjacency and/or attribute information. Adjacency information may be passed by using a full or bipartite adjacency matrix, incidence matrix, or edgelist as the function's first argument. These input types are defined as follows: \begin{description} \item[Adjacency matrix:] This must consist of a square \code{matrix} or two-dimensional \code{array}, whose $i,j$th cell contains the value of the edge from $i$ to $j$; as such, adjacency matrices may only be used to specify dyadic networks. By default, edges are assumed to exist for all non-zero matrix values, and are constructed accordingly. Edge values may be retained by passing \code{ignore.eval = FALSE}, as described in the manual page for the \code{network.adjacency} constructor. The \code{matrix.type} for an adjacency matrix is \code{"adjacency"}. \item[Bipartite adjacency matrix:] This must consist of a rectangular \code{matrix} or two-dimensional \code{array} whose row and column elements reflect vertices belonging to the lower and upper sets of a bipartition (respectively). Otherwise, the matrix is interpreted as per a standard adjacency matrix. (Thus, a bipartite adjacency matrix is simply the upper off-diagonal block of the full adjacency matrix for a bipartite graph, where vertices have been ordered by partition membership. See also \citet{doreian.et.al:bk:2005}.) The \code{matrix.type} for a bipartite adjacency matrix is \code{"bipartite"}. \item[Incidence matrix:] This must consist of a rectangular \code{matrix} or two-dimensional \code{array} whose row elements represent vertices, and whose column elements represent edges. A non-zero value is placed in the $i,j$th cell if vertex $i$ is an endpoint of edge $j$. In the directed case, negative values signify membership in the tail set of the corresponding edge, while positive values signify membership in the edge's head set. Unlike adjacency matrices, incidence matrices can thus be used to describe hypergraphic edges (directed or otherwise). Note, however, that an undirected hypergraph composed of two-endpoint edges is not the same as a simple graph, since the edges of the former are necessarily loop-like. When \code{loops}, \code{hyper}, and \code{directed} are all \code{FALSE}, therefore, the two positive row-elements of an incidence matrix for each column are taken to signify the head and tail elements of a dyadic edge. (This is without loss of generality, since such an incidence matrix would otherwise be inadmissible.) When specifying that an incidence matrix is to be used, \code{matrix.type} should be set to \code{"incidence"}. \item[Edge list:] This must consist of a rectangular \code{matrix} or two-dimensional \code{array} whose row elements represent edges. The $i,1$st cell of this structure is taken to be the ID of the tail vertex for the edge with ID $i$, with the $i,2$st cell containing the ID of the edge's head vertex. (Only dyadic networks may be input in this fashion.) Additional columns, if present, are taken to contain edge attribute values. The \code{matrix.type} for an edge list is \code{"edgelist"}. \end{description} As one might suspect, the \code{network} function actually operates by first calling \break\code{network.initialize} to create the required object, and then calling an appropriate edge set constructor based on the input type. This fairly modular design allows for the eventual inclusion of a wider range of input formats (although the above covers the formats currently in widest use within the social network community). Although \code{network} attempts to infer the matrix type from context, is wise to fix the function's behavior via the \code{matrix.type} argument when passing information which is not in the default, adjacency matrix form. As a simple example of the \code{network} constructor in action, consider the following: %\begin{Code} %#Create a less empty network %nmat <- matrix(rbinom(25,1,0.5),nr=5,nc=5) #Generate a random adjacency % #matrix %net <- network(nmat,loops=TRUE) #Use it to create a digraph % #w/loops %net #Display using print method %summary(net) #Display using summary method %all(nmat==net[,]) #Should be TRUE %\end{Code} <<>>= nmat <- matrix(rbinom(25, 1, 0.5), nr = 5, nc = 5) net <- network(nmat, loops = TRUE) net @ <<>>= summary(net) @ <<>>= all(nmat == net[,]) @ Here, we have generated a random adjacency matrix (permitting diagonal elements) and used this to construct a digraph (with loops) in \code{network} object form. Since we employed an adjacency matrix, there was no need to set the matrix type explicitly; had we failed to set \code{loops = TRUE}, however, the diagonal entries of \code{nmat} would have been ignored. The above example also demonstrates the use of an important form of operator overloading which can be used with dyadic network objects: specifically, dyadic network objects respond to the use of the subset and subset assignment operators \code{[} and \code{[<-} as if they were conventional adjacency matrices. Thus, in the above case, \code{net[,]} returns \code{net}'s adjacency matrix (a fact we verify by comparing it with \code{nmat}). This is an extremely useful ``shorthand'' which can be used to simplify otherwise cumbersome network operations, especially on small networks. The use of \code{network} function to create objects from input matrices has a functional parallel in the use of coercion methods to transform other objects into \code{network} form. These operate in the same manner as the above, but follow the standard \proglang{R} syntax for coercion, e.g.: %\begin{Code} %#Can also use coercion %net <- as.network(nmat, loops = TRUE) %all(nmat==net[,]) #Should still be TRUE %\end{Code} <<>>= net <- as.network(nmat, loops = TRUE) all(nmat == net[,]) @ By default, \code{as.network} assumes that square input matrices should be treated as adjacency matrices, and that diagonal entries should be ignored; here we have overridden the latter behavior by invoking the additional argument \code{loops = TRUE}. Matrix-based input can also be given in edgelist or incidence matrix form, as selected by the \code{matrix.type} argument. This and other options are described in greater detail within the package documentation. The above methods can be used in conjunction with \code{data}, \code{load}, or \code{read} functions to convert imported relational data into \code{network} form. For example, we may apply this to the Florentine data mentioned in the previous section: <<>>= nflo <- network(flo, directed = FALSE) nflo @ Although the network's adjacency structure is summarized here in edgelist form, it may be queried in other ways. For instance, the following example demonstrates three simple methods for examining the neighborhood of a particular vertex: <<>>= nflo[9,] nflo[9,1] nflo[9,4] is.adjacent(nflo, 9, 1) is.adjacent(nflo, 9, 4) @ As the example shows, overloading can be used to extract partial as well as complete adjacency information from a \code{network} object. A more cumbersome (but slightly faster) method is to use a direct call to \code{is.adjacent}, the general indicator method for network adjacency. Calling the indicator method avoids the call parsing required by the extraction operator, which is the source of the performance difference. In practice, however, the impact of call parsing is quite minimal, and users are unlikely to detect a difference between the two approaches. (Where such overhead is an issue, it will generally be more efficacious to conduct adjacency queries directly from the backend code; this will be discussed below, in the context of the \proglang{C}-language API.) In addition to adjacency, \pkg{network} supplies methods to query many basic properties of \code{network} objects. Although complex structural descriptives \citep[e.g., centrality scores][]{wass:faus1994} are the province of other packages, \pkg{network}'s built-in functionality is sufficient to determine the types of edges allowed within a \code{network} object and constraints such as enforced bipartitions, as well as essential quantities such as size (number of vertices), edge count, and density (the ratio of observed to potential edges). Use of these indicator methods is straightforward, as illustrated by the following examples. <<>>= network.size(nflo) #Number of vertices network.edgecount(nflo) #Number of edges network.density(nflo) #Network density has.loops(nflo) #Can nflo have loops? is.bipartite(nflo) #Is nflo coded as bipartite? is.directed(nflo) #Is nflo directed? is.hyper(nflo) #Is nflo hypergraphic? is.multiplex(nflo) #Are multiplex edges allowed? @ \subsection[Coercing network objects to other forms]{Coercing \code{network} objects to other forms} Just as one may often seek to coerce data from other forms into \code{network} object, so to does one sometimes need to coerce \code{network} objects into other data types. \pkg{network} currently supports several such coercion functions, all of which take network objects as input and produce matrices of one type or another. The class method for \code{as.matrix} performs this task, converting network objects to adjacency, incidence, or edgelist matrices as desired (adjacency being the default). Scalar-valued edge attributes, where present, may be used to set edge values using the appropriate functional arguments. Similar functionality is provided by \code{as.sociomatrix} and the extraction operator, although these are constrained to produce adjacency matrices. These equivalent approaches may be illustrated with application to the Florentine data as follows: <<>>= as.sociomatrix(nflo) all(nflo[,]==as.sociomatrix(nflo)) all(as.matrix(nflo)==as.sociomatrix(nflo)) as.matrix(nflo,matrix.type="edgelist") @ Note that vertex names (per the \code{vertex.names} attribute) are used by \code{as.sociomatrix} to set adjacency matrix row/column names where present. The less-flexible \code{as.sociomatrix} function also plays an important role with respect to coercion in the \pkg{sna} package; the latter's \code{as.sociomatrix.sna} dispatches to \pkg{network}'s \code{as.sociomatrix} routine when \pkg{network} is loaded and a \code{network} object is given. The intent in both packages is to maintain an interoperable and uniform mechanism for guaranteeing adjacency matrix representations of input data (which are necessary for backward compatibility with some legacy functions). \subsection{Creating and modifying edges and vertices} In addition to coercion of data to \code{network} form, the \pkg{network} package contains many mechanisms for creating, modifying, and removing edges and vertices from \code{network} objects. The simplest means of manipulating edges for most users is the use of the overloaded extraction and assignment operators, which (as noted previously) simulate the effects of working with an adjacency matrix. Thus, a statement such as \code{g[i,j] <- 1} adds an edge between \code{i} and \code{j} (if one is not already present), \code{g[i,j] <- 0} removes an existing edge, and \code{g[i,j]} itself is a dichotomous indicator of adjacency. Subset selection and assignment otherwise works in the same fashion as for \proglang{R} matrices, including the role of \code{logical}s and element lists. (One minor exception involves the effects of assignment on undirected and/or loopless graphs: \pkg{network} will enforce symmetry and/or empty diagonal entries, and will ignore any assignments which are contrary to this.) The uses of assignment by overloading are hence legion, as partially illustrated by the following: <<>>= #Add edges to an empty network net <- network.initialize(5,loops=TRUE) net[nmat>0] <- 1 #One way to add edges all(nmat==net[,]) #Should be TRUE net[,] <- 0 #Remove the edges net[,] <- nmat #Not quite kosher, but _will_ work.... all(nmat==net[,]) #Should still be TRUE net[,] <- 0 #Remove the edges for(i in 1:5) #Add the hard way! for(j in 1:5) if(nmat[i,j]) net[i,j] <- 1 all(nmat==net[,]) #Should STILL be TRUE net[,] <- 0 #Remove the edges add.edges(net,row(nmat)[nmat>0],col(nmat)[nmat>0]) all(nmat==net[,]) #When will it all end?? net[,] <- as.numeric(nmat[,]) all(nmat==net[,]) #When will it all end?? @ The above example also introduces \code{add.edges}, to which the overloaded assignment operator is a front end. \code{add.edges} is more cumbersome to employ than the assignment operators, but is substantially more powerful. In particular, it can be used to add edges of arbitrary type, with arbitrary attribute data. A comparison of usage is instructive; we begin by creating an empty digraph, and adding a single edge: <<>>= #Add edges (redux) net<-network.initialize(5) #Create empty graph add.edge(net,2,3) #Create 2->3 edge net[,] #Trust, but verify add.edges(net,c(3,5),c(4,4)) #3 and 5 send ties to 4 net[,] #Again, verify edges net[,2]<-1 #Everyone sends ties to 2 net[,] #Note that loops are not created! @ Observe that the (2,2) loop is not created, since \code{loops} is \code{FALSE} for this network. This automatic behavior is \emph{not} true of \code{add.edges}, unless optional edge checking is turned on (by means of the \code{edge.check} argument). For this reason, explicit use of \code{add.edges} is discouraged for novice users. In addition to edge addition/removal, vertices can be added or removed via \code{add.vertices} and \code{delete.vertices}. The former adds the specified number of vertices to a \code{network} object (along with any supplied attribute information), while the latter deletes a specified list of vertices from its argument. Usage is straightforward: <<>>= #Deleting vertices delete.vertices(net,4) #Remove vertex 4 net[,] #It's gone! add.vertices(net,2) #Add two new vertices net[,] #Both are isolates @ As the above illustrates, vertex names are not automatically created for newly added vertices\footnote{See the ``Persistent ID'' functionality in the the networkDynamic package for maintainable ids} (but can be subsequently assigned). New vertices are always added as isolates (i.e., without existing ties), and any edges having a deleted vertex as an endpoint are removed along with the deleted vertex. The use of \code{is.adjacent} (and friends) to perform adjacency testing has been shown above. While this is adequate for many purposes, it is sometimes necessary to examine an edge's contents in detail. As we have seen, each edge can be thought of as a list made up of a vector of tail vertex IDs, a vector of head vertex IDs, and a vector of attributes. The utility function \code{get.edges} retrieves edges in this form, returning them as lists with elements \code{inl} (tail), \code{outl} (head), and \code{atl} (attributes). \code{get.edges} allows for edges to be retrieved by endpoint(s), and is usable even on multiplex networks. Incoming or outgoing edges (or both) can be selected, as per the following example: <<>>= #Retrieving edges get.edges(net,1) #Out-edges sent by vertex 1 get.edges(net,2,neighborhood="in") #In-edges to vertex 2 get.edges(net,1,alter=2) #Out-edges from 1 to 2 @ The \code{alter} argument in the last case tells \code{get.edges} to supply only edges from vertex 1 to vertex 2. As with other applications of \code{get.edges}, this will return all applicable edges in the multiplex case. Retrieving edges themselves is useful, but does not provide the edges' ID information -- particularly in multiplex networks, such information is needed to delete or modify edges. For that purpose, we employ a parallel routine called \code{get.edgeIDs}: <<>>= #Retrieving edge IDs get.edgeIDs(net,1) #Same as above, but gets ID numbers get.edgeIDs(net,2,neighborhood="in") get.edgeIDs(net,1,alter=2) @ By the same token, it is sometimes the vertex neighborhood (rather than edge neighborhood) which is of interest. The \code{get.neighborhood} function can be used in these cases to obtain vertex neighborhoods directly, without having to first query edges. (Since this operation is implemented in the underlying compiled code, it is considerably faster than an \proglang{R}-level front end would be.) <<>>= #Vertex neighborhoods get.neighborhood(net,1) #1's out-neighbors get.neighborhood(net,2,type="in") #2's in-neighbors @ Finally, we note that edge deletion can be performed either by assignment operators (as noted above) or by the \code{delete.edges} function. \code{delete.edges} removes edges by ID, and hence is not primarily employed by end users. In conjunction with tools such as \code{get.edgeIDs}, however, it can be seen to be quite versatile. A typical example is as follows: <<>>= #Deleting edges net[2,3]<-0 #This deletes the 2->3 #edge net[2,3]==0 #Should be TRUE delete.edges(net,get.edgeIDs(net,2,neighborhood="in")) #Remove all->2 net[,] @ Since it works by IDs, it should be noted that \code{delete.edges} can be used to selectively remove edges from multiplex networks. The operator-based approach automatically removes any edges connecting the selected pair, and is not recommended for use with multiplex networks. \subsection{Working with attributes} A major advantage of \code{network} objects over simple matrix or list based data representations is the ability to store meta-information regarding vertices, edges, or the network as a whole. For each such attribute type, \pkg{network} contains access functions to manage the creation, modification, and extraction of such information. Here, we briefly introduce the primary functions used for these tasks, by attribute type. \subsubsection{Network attributes} As indicated previously, network-level attributes are those attached to the \code{network} object as a whole. Such attributes are created via the \code{set.network.attribute} function, which takes as arguments the object to which the attribute should be attached, the name of the attribute, and the value of the attribute in question. Network attributes may contain arbitrary data, as they are stored internally via generalized vectors (\code{list}s). To streamline the creation of such attributes, the network attribute operator, \code{\%n\%}, has also been provided. Assignment using the operator is performed via the syntax \code{network \%n\% "attrname" <- value}, as in the second portion of the example below (which assigns the first seven lowercase letters to an attribute called ``hoo'' in \code{net}). <<>>= net <- network.initialize(5) set.network.attribute(net, "boo", 1:10) net %n% "hoo" <- letters[1:7] @ After network attributes have been created, they may be listed using the \break\code{list.network.attributes} command. Attribute extraction may then be performed by a call to \code{get.network.attribute}, or via the network attribute operator. In the latter case, a call of the form \code{network \%n\% "attrname"} returns the value of attribute ``attrname'' in the object ``network.'' In our current example, for instance, we have created the attributes ``boo'' and ``hoo,'' each of which may be accessed using either method: <<>>= #List attributes list.network.attributes(net) #Retrieve attributes get.network.attribute(net,"boo") net %n% "hoo" @ Finally, it is sometimes desirable to remove network attributes which have been created. This is accomplished using \code{delete.network.attributes}, which removes the indicated attribute from the network object (freeing the associated memory). One can verify that the attribute has been removed by checking the list of network attributes, e.g: <<>>= #Delete attributes delete.network.attribute(net,"boo") list.network.attributes(net) @ \subsubsection{Vertex attributes} Vertex attributes are manipulated in the same general manner as network attributes, with the caveat that each vertex can have its own attributes. There is no requirement that all vertices have the same attributes, or that all attributes of a given name contain the same data type; however, not all extraction methods work well in the latter case. Complete functionality for arbitrary vertex creation, listing, retrieval, and deletion is provided by the \code{set.vertex.attribute}, \code{list.vertex.attributes}, \code{get.vertex.attribute}, and \break\code{delete.vertex.attribute} methods (respectively). These allow attribute data to be passed in list form (permitting arbitrary contents) and to be assigned to specific vertices. While the generality of these functions is helpful, they are cumbersome to use for simple tasks such as assigning scalar or character values to each vertex (or retrieving the same). To facilitate such routine tasks, \pkg{network} provides a vertex attribute operator, \code{\%v\%}. The operator may be used either for extraction or assignment, treating the right-hand value as a vector of attribute values (with the $i$th element corresponding to the $i$th vertex). By passing a \code{list} with a \code{list} for each element, one may assign arbitrary vertex values in this manner; however, the vertex operator will vectorize these values upon retrieval (and hence one must use \code{get.vertex.attribute} with \code{unlist = FALSE} to recover the full list structure). If a requested attribute is unavailable for a particular vertex, an \code{NA} is returned. Typical use of the vertex attribute methods is illustrated via the following example. Note that more complex usage is also possible, as detailed in the package manual. <<>>= #Add vertex attributes set.vertex.attribute(net,"boo",1:5) #Create a numeric attribute net %v% "hoo" <- letters[1:5] #Now, a character attribute #Listing attributes list.vertex.attributes(net) #List all vertex attributes #Retrieving attributes get.vertex.attribute(net,"boo") #Retrieve 'em net %v% "hoo" #Deleting attributes delete.vertex.attribute(net,"boo") #Remove one list.vertex.attributes(net) #Check to see that it's gone @ \subsubsection{Edge attributes} Finally, we come to edge attributes. The operations involved here are much like those for the network and vertex cases. List, set, get, and delete methods exist for edge attributes (\code{list.edge.attributes}, \code{set.edge.attribute}, \code{get.edge.attribute}, and \break\code{delete.edge.attribute}), as does an edge attribute operator (\code{\%e\%}). Operations with edges are rendered somewhat more complex, however, because of the need to employ edge IDs in referencing the edges themselves. These can be obtained via the \code{get.edgeIDs} function (as described above), but this adds complexity which is unnecessary in the case of simple attribute assignment on non-multiplex, dyadic graphs (where edges are uniquely identifiable by a pair of endpoints). For such cases, the convenience function \code{set.edge.value} allows edge values to be specified in adjacency matrix form. Also useful is the bracket operator, which can be used to assign values as well as to create edges. For network \code{net}, \code{net[sel, names.eval = "attrname"] <- value} will set the attribute named by ``attrname'' on the edges selected by \code{sel} (which follows standard \proglang{R} syntax for selection of cells from square matrices) to the values in \code{value}. By default, values for non-existent edges are ignored (although new edges can be created by adding \code{add.edges = TRUE} to the included arguments). Reasonable behavior for non-scalar values using this method is not guaranteed. In addition to the above, methods such as \code{as.sociomatrix} allow for edge attributes to be employed in some settings. These provide a more convenient (if less flexible) interface for the common case of scalar attributes on the edges of non-multiplex, dyadic networks. The following is a typical example of these routines in action, although much more exotic scenarios are certainly possible. <<>>= #Create a network with some edges net <- network(nmat) #Add attributes set.edge.attribute(net,"boo",sum(nmat):1) set.edge.value(net,"hoo",matrix(1:25,5,5)) #Note: only sets for extant edges! net %e% "woo" <- matrix(rnorm(25),5,5) #Ditto net[,,names.eval="zoo"] <- nmat*6 #Ditto if add.edges!=TRUE #List attributes list.edge.attributes(net) #Retrieving attributes get.edge.attribute(get.edges(net,1),"boo") #Get the attribute for 1's out-edges get.edge.value(net,"hoo") net %e% "woo" as.sociomatrix(net,"zoo") #Deleting attributes delete.edge.attribute(net,"boo") list.edge.attributes(net) @ As this example illustrates, edge attributes are only set for actually existing edges (although the optional \code{add.edges} argument to the network assignment operator can be used to force addition of edges with non-zero attribute values). Also illustrated is the difference between attribute setting using \code{set.edge.attribute} (which is edge ID based) and function such as the assignment operator. The relative ease of the latter recommends itself for everyday use, although more complex settings may call for the former approach. \subsubsection{From attributes to networks} In addition to simply storing covariate information, it should be noted that one can actively use attributes to construct new networks. For instance, consider the \code{emon} data set used above. Among other variables, each vertex carries an attribute called \code{"Location"} which contains information on whether the corresponding organization had headquarters or command post installations which were local, non-local, or both with respect to the operation from which the network was drawn. We may thus use this information to construct a very simple hypergraph, in which locations constitute edges and edge membership is defined as having an installation at the respective location. For the Mt.\ St.\ Helens network, such a network may be constructed as follows. First, we extract the location information from the relevant network object, and use this to build an incidence matrix based on location. Then we convert this incidence matrix to a hypergraphic network object (setting vertex names from the original network object for convenience). <<>>= #Extract location information MtSHloc<-emon$MtStHelens%v%"Location" #Build an incidence matrix based on Local/Non-local/Both placement MtSHimat<-cbind(MtSHloc%in%c("L","B"),MtSHloc%in%c("NL","B")) #Convert incidence matrix to a hypergraph MtSHbyloc<-network(MtSHimat,matrix="incidence",hyper=TRUE,directed=FALSE, loops=TRUE) #Set vertex names, for convenience MtSHbyloc%v%"vertex.names"<-emon$MtStHelens%v%"vertex.names" #Examine the result MtSHbyloc @ Obviously, the simple location coding used here cannot lead to a very complex structure. Nevertheless, this case serves to illustrate the flexibility of the \pkg{network} tools in allowing attribute information to be used in creative ways. In addition to constructing networks from attributes, one can use attributes to store networks \citep[useful for joint representation of cognitive and behavioral structures such as those of][]{krackhardt:sn:1988,killworth.bernard:ho:1976}, edge timing information (for dynamic structures, as in the package \pkg{networkDynamic} \citep{networkDynamic}), etc. Appropriate use of network, edge, and vertex attributes allows a wide range of complex relational data structures to be supported without the need for a cumbersome array of of custom data classes. \subsection[Visualizing network objects]{Visualizing \code{network} objects} In addition to manipulating \code{network} objects, the \pkg{network} package provides built-in support for network visualization. This capability is supplied by the package \code{plot} method (ported from \pkg{sna}'s \code{gplot}), which is dispatched transparently when \code{plot} is called with a \code{network} object. The plot method supports a range of layout and display options, which are specified through additional arguments. For instance, to visualize the Florentine marriage data we might use commands such as the following: <<>>= plot(nflo, displaylabels = TRUE, boxed.labels = FALSE) plot(nflo, displaylabels = TRUE, mode = "circle") @ Typical results of these commands are shown in Figure~\ref{f_nflo_layout}. Note that the plot method automatically determines whether the network being visualized is directed, and adds or suppresses arrowheads accordingly. For instance, compare the above with the Mt.\ Si communication network (Figure~\ref{f_mtsi}): \begin{figure} \begin{center} %\rotatebox{270}{\resizebox{3in}{6in}{\includegraphics{nflo.layouts.ps}}} %\rotatebox{270}{\resizebox{3in}{6in}{\includegraphics{Figures/nflo_layouts.pdf}}} <>= op<-par(no.readonly=TRUE) # cache the plot params par(mfcol=c(1,2),mar=c(1,1,1,1),cex=0.5) # adjust margins and text size to fit two panels plot(nflo, displaylabels = TRUE,boxed.labels = TRUE) plot(nflo, displaylabels = TRUE, mode = "circle") par(op) # reset the plot params @ \caption{\label{f_nflo_layout} Sample displays of the Florentine marriage data; the left panel depicts the default Fruchterman-Reingold layout, while the right panel depicts a circular layout.} \end{center} \end{figure} <<>>= plot(emon$MtSi) @ \begin{figure} \begin{center} %\rotatebox{270}{\resizebox{4in}{4in}{\includegraphics{mtsi.layout.ps}}} %\rotatebox{0}{\resizebox{4in}{4in}{\includegraphics{Figures/mtsi_layout.pdf}}} <>= plot(emon$MtSi) @ \caption{\label{f_mtsi} Sample display of the Mt.\ Si EMON data, using the default Fruchterman-Reingold layout.} \end{center} \end{figure} The default layout algorithm for the plot method is that of \citet{fruchterman.reingold:spae:1991}, a force-directed display with good overall performance. Other layout methods are available \citep[including the well-known energy-minimization algorithm of][]{kamada.kawai:ipl:1989}, and support is included for user-added functions. To create a custom layout method, one need only create a function with the prefix \code{network.layout} which supplies the appropriate formal arguments (see the \pkg{network} manual for details). The \code{plot} method can then be directed to utilize the custom layout function, as in this simple example (shown in Figure~\ref{f_mtsthelens_custom}): <<>>= library(sna) network.layout.degree <- function(d, layout.par){ id <- degree(d, cmode = "indegree") od <- degree(d, cmode = "outdegree") cbind(id, od) } plot(emon$MtStHelens, mode = "degree", displaylabels = TRUE, boxed.labels = FALSE, suppress.axes = FALSE, label.cex = 0.5, xlab = "Indegree", ylab = "Outdegree", label.col = 3) @ \begin{figure} \begin{center} %\rotatebox{270}{\resizebox{6in}{6in}{\includegraphics{mtsthelens.custom.layout.ps}}} %\rotatebox{270}{\resizebox{6in}{6in}{\includegraphics{Figures/mtsthelens_custom_layout.pdf}}} <>= plot(emon$MtStHelens, mode = "degree", displaylabels = TRUE, boxed.labels = FALSE, suppress.axes = FALSE, label.cex = 0.5, xlab = "Indegree", ylab = "Outdegree", label.col = 3) @ \caption{\label{f_mtsthelens_custom} Sample display of the Mt.\ St.\ Helens EMON data, using a custom indegree/outdegree layout.} \end{center} \end{figure} As this example illustrates, most properties of the visualization can be adjusted where necessary. This is especially helpful when visualizing structures such as hypergraphs: <<>>= plot(MtSHbyloc, displaylabels = TRUE, label = c(network.vertex.names(MtSHbyloc), "Local", "Non-Local"), boxed.labels = FALSE, label.cex = rep(c(0.5, 1), times = c(27, 2)), label.col = rep(c(3, 4), times = c(27, 2)), vertex.col = rep(c(2, 5), times = c(27, 2))) @ Note that the \code{plot} method automatically recognizes that the network being passed is hypergraphic, an employs a two-mode representation for visualization purposes (see Figure~\ref{f_mtsthelens_twomode}). Supplying custom labeling and vertex coloring helps clarify the interpretation. For instance, here we can immediately see the division between organizations who maintained headquarters exclusively at local or remote locations during the Mount St. Helens search and rescue operation, as well as those organizations (e.g. the Salvation Army and Red Cross) which bridged the two. Though simple, examples such as this demonstrate how the default \emph{plot} settings can be adjusted to produce effective visualizations of even complex relational data. \begin{figure} \begin{center} %\rotatebox{270}{\resizebox{4.5in}{6in}{\includegraphics{mtsthelens.twomode.ps}}} %\rotatebox{270}{\resizebox{4.5in}{6in}{\includegraphics{Figures/mtsthelens_twomode.pdf}}} <>= plot(MtSHbyloc, displaylabels = TRUE, label = c(network.vertex.names(MtSHbyloc), "Local", "Non-Local"), boxed.labels = FALSE, label.cex = rep(c(0.5, 1), times = c(27, 2)), label.col = rep(c(3, 4), times = c(27, 2)), vertex.col = rep(c(2, 5), times = c(27, 2))) @ \caption{\label{f_mtsthelens_twomode} Sample display of the Mt.\ St.\ Helens location hypergraph, showing division between locally, non-locally, and dual headquartered organizations.} \end{center} \end{figure} \section[C-language API]{\proglang{C}-language API} While the functionality described thus far has been aimed at users working within an interpreted \proglang{R} environment, many \pkg{network} package features can also be accessed through a \proglang{C}-language application programming interface (API). Although this API still makes use of \proglang{R} data structures, it provides mechanisms for direct manipulation of those structures via compiled code. While invisible to most end users, the API has a number of attractions for developers. Chief among these is performance: in the author's experience, a reasonably well-designed \proglang{C} function can run as much as one to two orders of magnitude faster than an equivalent \proglang{R} implementation. For many day-to-day applications, such gains are unlikely to be worth the considerable increase in implementation and maintenance costs associated with choosing \proglang{C} over \proglang{R}; however, they may prove vital when performing computationally demanding tasks such as Markov chain Monte Carlo simulation, large-graph computations, and small-N solutions for non-polynomial time problems (e.g., cycle counting). Another useful feature of the \proglang{C} API is its ability to make the complex data storage capabilities of \code{network} objects accessible to developers whose projects involve existing backend code, or developing packages such as \pkg{networkDynamic} which extend \pkg{network}'s functionality at the \proglang{C} level. Instead of performing data extraction on a \code{network} object and passing the result to the compiled routine, the \pkg{network} API allows for such routines to work with such objects directly. Finally, a third useful asset of the \pkg{network} API is the capacity it provides for generating user-transparent functionality which transcends what is feasible with \proglang{R}'s pass-by-value semantics. The use of compiled code to directly modify objects without copying has been fundamental to the functionality of the package since version 1.0, as can be gleaned from an examination of the package source code\footnote{The pass-by-value semantics are somewhat contrary to R's design philosophy and have been somewhat blocked in recent R versions. While the pass-by-value semantics functionality described is still operational, it must be implemented in less than optimal ways and my not offer the original speed gains.}. The mechanism by which the API is currently implemented is fairly simple. A shared header file (which must be included in the user's application) defines a series of macros which point to the package's internal routines. During program execution, a global registration function is used to map these macros to their internal symbols; following this, the macros may be called normally. Other then ensuring that the \pkg{network} library is loaded prior to invoking the registration function, no other measures are necessary. In particular, the calling routine does not have to be linked against the \pkg{network} library, although the aforementioned header/registration routines must be included at compile time.\footnote{Required files for the \pkg{network} API are available from \url{http://www.statnetproject.org/}.} In addition, \pkg{network} versions 1.11.1 and higher implement \proglang{R}'s template for registering native \proglang{C} routines \footnote{See the `Registering-native-routines' section of \url{http://cran.r-project.org/doc/manuals/r-release/R-exts.html }} so that packages may compile against \pkg{network}'s code by declaring a \code{LinkingTo: network} in the DESCRIPTION file. The listing of exported functions are in the file \code{src/Rinit.c}. \subsection[Using the network API]{Using the \pkg{network} API} To use the \pkg{network} API within one's own code, the following steps are necessary: \begin{enumerate} \item The required \pkg{network} header and function registration files must be added to the developer's source tree. \item The \pkg{network} header file must be included during compilation. \item The \code{netRegisterFunctions} function must be invoked at the entry point to any \proglang{C} program using the API. \item The \pkg{network} API functions must be used as required. \end{enumerate} The command \code{netRegisterFunctions} takes and returns no arguments, being invoked solely for its side effect. Although it must be called at each entry to the \proglang{C} backend (i.e., each invocation of \code{.Call} or \code{.External} from \proglang{R}), its effects persist until the calling routine exits. The API is designed for use with the \code{.Call} interface, although wrappers for conversion to \code{.External} are in principle possible. Object references are maintained through \code{SEXP} pointers, as is standard for \proglang{R}'s \proglang{C} language interface. Because references (rather than copies of the objects themselves) are passed to \proglang{C} via the interface, \proglang{C} routines may directly alter the objects with which they are called. \pkg{network} has many routines for creating and modifying \code{networks}, as well as for accessing object contents within compiled code. To illustrate the use of the network API in practical settings, we here provide a walk-through for a relatively simple (but non-trivial) example. Consider a \proglang{C} function which generates an undirected network from a homogeneous Bernoulli graph distribution, tagging each edge with random ``onset'' and ``termination'' times based on a piecewise-exponential process with fixed onset/termination hazards. Such a function might also keep track of the first and last edge times for each vertex (and for the network as a whole), storing these within the network object via appropriately named attributes. To implement our sample function, we begin with the standard header for a \code{.Call} function, which both takes and receives arguments of type \code{SEXP} (S-expression pointers). In this case, the parameters to be passed consist of an initialized \code{network} object, the probability of an edge between any two vertices, and the hazards for edge onset and termination (respectively). Note that we do not need to tell the function about properties such as network size, since it can determine these itself using the API's interface methods. \begin{Code} SEXP rnbernexp_R(SEXP g, SEXP ep, SEXP oh, SEXP th) /* C-Language code for a simple random dynamic network generator. Arguments are as follows: g - a pre-initialized network object ep - the edge probability parameter oh - the edge onset hazard parameter th - the edge termination hazard parameter */ { int n, i, w; double u, fet, let, *vfet, *vlet, ot, tt; SEXP tail, head, atl, atlnam, sot, stt, ec; /*Verify that we were called properly, and set things up*/ netRegisterFunctions(); if(!netIsNetwork(g)) error("rnbernexp_R must be called with a network object.\n"); if(netIsDir(g)) error("Network passed to rnbernexp_R should be undirected.\n"); n = netNetSize(g); PROTECT(ep = coerceVector(ep, REALSXP)); PROTECT(oh = coerceVector(oh, REALSXP)); PROTECT(th = coerceVector(th, REALSXP)); PROTECT(ec = allocVector(LGLSXP, 1)); LOGICAL(ec)[0] = 0; GetRNGstate(); /*Allocate memory for first/last edge time trackers*/ vfet = (double *)R_alloc(n, sizeof(double)); vlet = (double *)R_alloc(n, sizeof(double)); for(i = 0; i < n; i++) vfet[i] = vlet[i] = NA_REAL; fet = let = NA_REAL; \end{Code} In order to assure that all arguments are of the appropriate type, we employ a combination of verification and coercion. After registering the \pkg{network} API functions using \code{netRegisterFunctions}, we use the indicators \code{netIsNetwork} and \code{netIsDir} to verify that the \code{g} argument is indeed a \code{network} object, and that it is undirected. After verifying these conditions, we can use \code{netNetSize} to obtain the number of vertices in the network. This quantity is saved for further use. With the preliminaries out of the way, we are now in a position to draw edges. The algorithm used to generate the underlying graph is that of \cite{batagelj.brandes:pre:2005}, which scales well for sparse graphs (complexity is $\mathcal{O}(n+m)$). Edges themselves are added via the \code{netAddEdge} API function, which is analogous to \code{add.edge} in the \proglang{R} interface. Because we are operating directly on the network object, we must handle memory allocation ourselves: the \code{allocVector} calls in the following section are used to allocate memory for the head, tail, and attribute lists, and for the vector of attribute names. These are set accordingly, with the ``OnsetTime'' and ``TerminationTime'' attributes being created to store edge onsets and terminations, respectively. Once the edge elements are created, \code{netAddEdge} assures that they are placed within the \code{network} object; since \proglang{R}'s garbage collection mechanism protects these elements once they are linked to \code{g} (which is a protected object), we can subsequently remove them from the memory protection stack using \code{UNPROTECT}. \begin{Code} /*Draw the network information*/ w = -1; i = 1; while(i < n){ u = runif(0.0, 1.0); w += 1+ (int)floor(log(1.0 - u) / log(1.0 - REAL(ep)[0])); while((w >= i) && (i < n)){ w -= i; i++; } if(i < n){ /*Generate an edge*/ /*Draw and track timing information*/ ot = rexp(REAL(oh)[0]); tt = ot + rexp(REAL(th)[0]); fet = ((ISNA(fet)) || (ot < fet)) ? ot : fet; let = ((ISNA(let)) || (tt > let)) ? tt : let; vfet[i] = ((ISNA(vfet[i])) || (ot < vfet[i])) ? ot : vfet[i]; vlet[i] = ((ISNA(vlet[i])) || (tt > vlet[i])) ? tt : vlet[i]; /*Allocate memory for the new edge*/ PROTECT(tail = allocVector(INTSXP, 1)); /*Allocate head/tail*/ PROTECT(head = allocVector(INTSXP, 1)); INTEGER(tail)[0] = i + 1; INTEGER(head)[0] = w + 1; PROTECT(atl = allocVector(VECSXP, 2)); /*Allocate attributes*/ PROTECT(sot = allocVector(REALSXP, 1)); PROTECT(stt = allocVector(REALSXP, 1)); PROTECT(atlnam = allocVector(STRSXP, 2)); SET_STRING_ELT(atlnam, 0, mkChar("OnsetTime")); SET_STRING_ELT(atlnam, 1, mkChar("TerminationTime")); REAL(sot)[0] = ot; REAL(stt)[0] = tt; SET_VECTOR_ELT(atl, 0, sot); SET_VECTOR_ELT(atl, 1, stt); g = netAddEdge(g, tail, head, atlnam, atl, ec); /*Add the edge*/ UNPROTECT(6); } } \end{Code} At this point, all edges have been placed within the network. While we could stop here, it seems useful to first tabulate some basic meta-data regarding the network being produced. In particular, a function to analyze a network of this type would doubtless need to know the total time interval over which each vertex (and the network as a whole) is active. Via the \pkg{network} API, we can easily store this information in \code{g}'s network and vertex attribute lists before returning. To do this, we employ \code{netSetVertexAttrib} and \code{netSetNetAttrib}, API functions which are analogous to \code{set.vertex.attribute} and \code{set.network.attribute}. As with the case of edge addition, we must allocate memory for the attribute entry prior to installing it -- the \code{netSet*} routines pass references to their arguments, rather than copying them -- but these functions do handle the creation of attribute names from raw strings. After writing our metadata into the graph, we clear the protection stack and return the \proglang{R} object pointer. \begin{Code} /*Add network and vertex attributes*/ for(i = 0; i < n; i++){ PROTECT(sot = allocVector(REALSXP, 1)); PROTECT(stt = allocVector(REALSXP, 1)); REAL(sot)[0] = vfet[i]; REAL(stt)[0] = vlet[i]; g = netSetVertexAttrib(g, "FirstOnsetTime", sot, i + 1); g = netSetVertexAttrib(g, "LastTerminationTime", stt, i + 1); UNPROTECT(2); } PROTECT(sot = allocVector(REALSXP, 1)); PROTECT(stt = allocVector(REALSXP, 1)); REAL(sot)[0] = fet; REAL(stt)[0] = let; g = netSetNetAttrib(g, "FirstOnsetTime", sot); g = netSetNetAttrib(g, "LastTerminationTime", stt); /*Clear protection stack and return*/ PutRNGstate(); UNPROTECT(6); return g; } \end{Code} To use the \code{rnbernexp_R} function, it must be invoked from \proglang{R} using the \code{.Call} interface. A simple wrapper function (whose behavior is similar to \proglang{R}'s built-in random number generation routines) might look like the following: <<>>= rnbernexp <- function(n, nv, p = 0.5, onset.hazard = 1, termination.hazard = 1){ nets <- list() for(i in 1:n) nets[[i]] <- .Call("rnbernexp_R", network.initialize(nv, directed = FALSE), p, onset.hazard, termination.hazard, PACKAGE = "networkapi.example") if(i > 1) nets else nets[[1]] } @ In actual use, the \code{PACKAGE} setting would be changed to the name of the shared object file in which the \code{rnbernexp_R} symbol resides. (This file would need to be linked against the \code{networkapi} file, and dynamically loaded after \pkg{network} is in memory. Linking against the entire \pkg{network} library is not required, however.) Although the specific distribution simulated is too simplistic to serve as a very good model of social dynamics, it nevertheless illustrates how the \pkg{network} API can be used to efficiently simulate and store the results of non-trivial processes within compiled code. \section{Final comments} For several decades, tools for social network analysis were essentially isolated from those supporting conventional statistical analyses. A major reason for this isolation was the difficulty in manipulating -- or even representing -- relational data within standard statistical packages. In recent years, the emergence of flexible statistical computing environments such as \proglang{R} have helped to change this situation. Platforms like \proglang{R} allow for the creation of the complex data structures needed to represent rich relational data, while also facilitating the development of tools to make such structures accessible to the end user. The \pkg{network} package represents one attempt to leverage these capabilities in order to create a low-level infrastructure for the analysis of relational data. Together with packages like \pkg{sna}, \pkg{ergm}, and the rest of the \pkg{statnet} suite, it is hoped that \pkg{network} will provide a useful resource for scientists both inside and outside of the social network community. \section*{Acknowledgments} The author gratefully acknowledges the input of present and past \pkg{statnet} collaborators, including Mark Handcock, David Hunter, Daniel Westreich, Martina Morris, Steve Goodreau, Pavel Krivitsky, and Krista Gile. This paper is based upon work supported by National Institutes of Health award 5 R01 DA012831-05, subaward 918197, and by NSF award IIS-0331707. \begin{thebibliography}{} \bibitem[Batagelj \& Brandes(2005)]{batagelj.brandes:pre:2005} Batagelj V, Brandes U (2005). ``Efficient Generation of Large Random Networks.'' \emph{Physical Review E}, 71(3), 036113, 1-5. doi:10.1103/PhysRevE.71.036113. \bibitem[Batagelj(2007)]{pajek} Batagelj V, Mrvar A (2007). \emph{Pajek: Package for Large Network Analysis.} University of Ljubljana, Slovenia. URL \url{http://vlado.fmf.uni-lj.si/pub/networks/pajek/}. \bibitem[Butts(2002)]{butts:tr:2002} Butts CT (2002). ``Memory Structures for Relational Data in R: Classes and Interfaces.'' \emph{Unpublished manuscript}, University of California, Irvine. \bibitem[Butts(2007)]{sna} Butts CT (2007). \emph{sna: Tools for Social Network Analysis}. Statnet Project \url{http://statnetproject.org/}, Seattle, WA. R package version 1.5, URL \url{http://CRAN.R-project.org/package=sna}. \bibitem[Butts \& Carley(2005)]{butts.carley:cmot:2005} Butts CT, Carley KM (2005). ``Some Simple Algorithms for Structural Comparison.' \emph{Computational and Mathematical Organization Theory}, 11(4), 291-305. \bibitem[Butts, et al.(2007)]{network} Butts CT, Handcock MS, Hunter DR (2007). \emph{network: Classes for Relational Data}. Statnet Project \url{http://statnetproject.org/}, Seattle, WA. R package version 1.3, URL \url{http://CRAN.R-project.org/package=network}. \bibitem[Butts, et all.(2014)]{networkDynamic} Butts CT, Leslie-Cook A, Krivitsky P and Bender-deMoll S (2014). \emph{networkDynamic: Dynamic Extensions for Network Objects.} R package version 0.6.3. http://statnet.org URL \url{http://CRAN.R-project.org/package=networkDynamic} \bibitem[Carey, et al.(2007)]{carey.et.al:sw:2007} Carey VJ, Long L, Gentleman R (2007). \emph{RBGL: R Interface to Boost C++ Graph Library}. R package version 1.14.0, URL \url{http://www.bioconductor.org/}. \bibitem[Chambers(1998)]{chambers:bk:1998} Chambers JM (1998). \emph{Programming with Data}. Springer-Verlag, New York. ISBN 0-387- 98503-4. \bibitem[Csardi \& Nepusz(2006)]{gabor:sw:2007} Csardi G, Nepusz T (2006). ``The igraph Software Package for Complex Network Re- search.'' \emph{InterJournal, Complex Systems}, 1695. URL \url{http://www.interjournal.org/manuscript_abstract.php?361100992.} \bibitem[Doreian, et al.(2005)]{doreian.et.al:bk:2005} Doreian P, Batagelj V, Ferlioj A (2005). \emph{Generalized Blockmodeling}. Cambridge University Press, Cambridge. \bibitem[Drabek, et al.(1981)]{drabek.et.al:bk:1981} Drabek TE, Tamminga HL, Kilijanek TS, Adams CR (1981). \emph{Managing Multiorganizational Emergency Responses: Emergent Search and Rescue Networks in Natural Disaster and Remote Area Settings}. Number Monograph 33 in Program on Technology, Environment, and Man. Institute of Behavioral Sciences, University of Colorado, Boulder, CO. \bibitem[Fruchterman \& Reingold(1991)]{fruchterman.reingold:spae:1991} Fruchterman TMJ, Reingold EM (1991). ``Graph Drawing by Force-directed Placement.' \emph{Software -- Practice and Experience}, 21(11), 1129-1164. \bibitem[Gentleman, et al.(2007)]{gentleman.et.al:sw:2007} Gentleman R, Whalen E, Huber W, Falcon S (2007). \emph{graph: A Package to Handle Graph Data Structures}. R package version 1.14.2, URL \url{http://CRAN.R-project.org/package=graph.} \bibitem[Gentry, et al.(2007)]{gentry.et.al:sw:2007} Gentry J, Long L, Gentleman R, Falcon S (2007). \emph{Rgraphviz: Plotting Capabilities for R Graph Objects}. R package version 1.16.0, URL \url{http://CRAN.R-project.org/package=Rgraphviz}. \bibitem[Handcock, et al.(2003)]{statnet} Handcock MS, Hunter DR, Butts CT, Goodreau SM, Morris M (2003). \emph{statnet: Software Tools for the Statistical Modeling of Network Data}. Statnet Project \url{http://statnetproject.org/}, Seattle, WA. R package version 2.0, URL \url{http://CRAN. R-project.org/package=statnet}. \bibitem[Kamada\& Kawai(1989)]{kamada.kawai:ipl:1989} Kamada T, Kawai S (1989). ``An Algorithm for Drawing General Undirected Graphs.'' \emph{Information Processing Letters}, 31(1), 7-15. \bibitem[Killworth \& Bernard(1976)]{killworth.bernard:ho:1976} Killworth PD, Bernard HR (1976). ``Informant Accuracy in Social Network Data.'' \emph{Human Organization}, 35(8), 269-286. \bibitem[Koenker \& Ng(2007)]{koenker.ng:sw:2007} Koenker R, Ng P (2007). \emph{SparseM: Sparse Linear Algebra}. R package version 0.73, URL \url{http://CRAN.R-project.org/package=SparseM}. \bibitem[Krackhardt(1988)]{krackhardt:sn:1988} Krackhardt D (1988). ``Predicting with Networks: Nonparametric Multiple Regression Anal- yses of Dyadic Data.'' \emph{Social Networks}, 10, 359-382. \bibitem[Mayhew \& Levinger(1976)]{mayhew.levinger:ajs:1976} Mayhew BH, Levinger RL (1976). ``Size and Density of Interaction in Human Aggregates.'' \emph{American Journal of Sociology}, 82, 86-110. \bibitem[R Development Core Team(2007)]{R} R Development Core Team (2007). \emph{R: A Language and Environment for Statistical Computing}. R Foundation for Statistical Computing, Vienna, Austria. ISBN 3-900051-07-0, Version 2.6.1, URL \url{http://www.R-project.org/}. \bibitem[Venables \& Ripley(2000)]{venables.ripley:bk:2000} Venables WN, Ripley BD (2000). \emph{S Programming}. Springer-Verlag, New York. ISBN 0-387-98966-8. \bibitem[Venables \& Ripley(2002)]{venables.ripley:bk:2002} Venables WN, Ripley BD (2002). \emph{Modern Applied Statistics with S}. Springer-Verlag, New York, fourth edition. ISBN 0-387-95457-0. \bibitem[Wasserman \& Faust(1994)]{wass:faus1994} Wasserman SS, Faust K (1994). \emph{Social Network Analysis: Methods and Applications}. Structural Analysis in the Social Sciences. Cambridge University Press, Cambridge. \end{thebibliography} \end{document} network/inst/doc/networkVignette.pdf0000644000176200001440000073020514061532364017372 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 4554 /Filter /FlateDecode /N 86 /First 722 >> stream x\w6~ |܆$`y5q&==6m3I_$J6un`XtifYKϜf979qȄuQYtf*@)c'g:ic3ÍbB0#e  439,Zf5: 0,sfsdqgi )sxK)9˅LbF:Gݰ$P2AX $2rAʼnwє0!^)$&4 Q#7 &ù'"39O{ Bj4 Y׀,\FdB! 2mПK5 KKx8@9l1@_cYp3$\M9b1첀-5I sa ,BĊ8n4D‚8֑ A<<((tvl &ZuB[2Ȏw]qZt;dY7r *?_,EIs~уx4.=-ڮl̺n:eUMWt%{w0˲u} vڶg׈UMD6#5J_T`[ځ!`p"%rJƫW=u|L&V#57n#&h S?FWX\kh:”T#ck{/AH{y#2ev+kqPӪi>)I:Nvwf֞`H 12NA_(={O "˜׀QӎӗŔz>,+\Fҷf =:`J=L`&,BLH,*'>JŨ;$ (Pj@(*#ds(:0Y(QteV(:@n c=1VwN1-o?_6EW^V<{xX&EIsJ!}SՏiu}o0"ؕmVGo: !{oXe9AkX?kgcI+c7}ZyYO֯Pzݾq_€IoਗJ%\Ȧ'!'\=+ + LJS'2$({rpy%ޮ;N<^r/pqxb ^ZY?S(HP]u\i_lP}9? *i/@7vE{$}>:%5}A?4NOȟU52.:$*CSP8YUs5cZ}vtmYg-ڷrrHhZՔ :VEWV<{|uؙUk쮺b(x􍂖-_K-k}龯KL:+"&% Al?""t6 'Ic tmxί&2!Wt,.#uAեCCtݸe-k1״~A9}uhuAKhт4C?DZ֧+^NnT׵~2)ϺPj=` MSV?fMWO|ǾZ(zr00tBh~g6KO[p}+ϲwEoV˱&@&?an١-0+^#eΆkIfy0һ.-v%.eYXYFdsc FXb!Wܝ-؏.Gg"(,soUE:2e{-FX'0V)`0*Ļ!LuwS,P-PAj Z,%eBOu{6Q,ܬ77b9 Fgf\Mf/eEAĢ:4S㿢vU=6 z<ڹقWMlmΰ5*ykƖ݌8f+7ת?73K EOx\qѦmqRz×SAe7rhXUfvt2).EZX)\C]鵋T.uu^o-y A.S9d]=էi˛<%>*V2;&m'.2|눥>{3փ!M?~9뒦=O?VA|rliA~.ᮯ L!%Ef0Io u8D/+J@΍Ƒ|%Mc 'NL,YHyIۄ^'JiJ$qHS6kCi/l1;Ӳ.d͘1zћý+WǓ 5r)Љzu-0,:\!njcӎo:%LY&㢺^ٹXuP`aCtmb-N w/o Jf>zAvo%l덮@l{W)awNω%UZm1;OKdsږgtv<-Q9(d9%B6HF=z8Ox; [sa[cDn8B;]ZbZW 727* 9` x;Fnjޓ}Bliׅz<5i{uvقl1[ UNly"s8 &KB DCm,0aظ;-e;Mk6-9Y5~#ؿAL{%nlTg&2=9yA(ZҒ>t)TB{5 gH)kܹ9R:㉍٧Hh*Kc%hSM$dL[JLoq#$zrְeur  NND7jN5MiFh@3(wl5.&ˢTӮ-&uV-HNkzv9%,gCv?F4E?u(Cv➽/lfq'YωzOt\QIմheS&-ش-㽕Lb(]e?ɗȷ7E o*-kz=" yO8ћ|k=z_endstream endobj 88 0 obj << /Subtype /XML /Type /Metadata /Length 1515 >> stream GPL Ghostscript 9.53.3 relational data, data structures, graphs, network, statnet, R 2021-06-13T18:46:27-07:00 2021-06-13T18:46:27-07:00 LaTeX with hyperref network: A Package for Managing Relational Data in RCarter T. Butts endstream endobj 89 0 obj << /Type /ObjStm /Length 2816 /Filter /FlateDecode /N 86 /First 784 >> stream x[[SH}_я~*aYH%$L2xcl69_ *c$ݧ2Q0d2DOYY4KŢeQHB=ң,0udI+4%($SF7)b),SApL PN`Z Hh?,PxE7* f%-8f-zd`682'Z^*ɜvsJsPa.H%yA 'IZSyC]h]?2l4CB!Г`dA1*e~VNFwrZK ޽_S4_16E %5uUq||UMAtZ@/1TL5KWgjFh:΃ypz]x }n΀_!#JQ8lA xjlyQ4|xtz|!#ʫ}cXFՒnۙXcVfŬVVelj+REZ㌖Y d">_aB2Q$mho*|Lw7[ݯA_&/rRKx~>|Ƨ\!jOQE-&m Yj"lKmK￿xj^CK:B#5ٜa%|x-Ɂ5_-APPI|Z#)wf1KzwAO#a0Sxrǿol0zR+JWf#m zkW]]bҺSٻ34}[R6ɦxϳ9GҭHgLGLXE:2L/׼H8hCfjҳ6:OoV咅r(:_-UGJ(%d>Ja [|h]uBXf.fTnlf]F[eO\Dž0c~OK~_7|TOzËϺuͯ^Ī,y؇E][ iu79._Ѵ4H7i^^_]lsw y̕!W^֛E,hmfvVQz#5Wv>[+7-מ h dm4W#2I2@ ̆Vl,t#G_!?*"G 2( &PȪJF][c {pH`HAɧ&й@i{Pk\չ7A$pS9Q9(iKo]G]=d鸋#T??IA@)\uT? 3wiȅFY  $&yPH$$S0H!TPAYТ=]3 iDLN!kcUmdOLbg;fC ԱtG)l ө5dl, bM-0mJӡ,NMvNO[ﱳ3f;-, twauvr>=scMߣkaUTÁE9T=I~sTNC+e}IFP~HkĻ숡Eg e([>ljwNQΎ1:񓜢3kag .J;q>$8GfWevv@\Vji8=vҶ b:n<YtҢQ"-7CtD[YҚ6-tD mv%ؼ0 qf7M;lvrۧZt9]v:˨e(Ulc(iĥ mrIMp?8sؿ,!rîB".-ӑlH 7E7HYцendstream endobj 176 0 obj << /Type /ObjStm /Length 3160 /Filter /FlateDecode /N 84 /First 760 >> stream xZis7Ji0T6(ɦ\[45&frh! )J@Cwcs,eygx=|j)8|-m1eeƊ)gd:ji#tbt_ t̳3ϡl礙*ds6.Xvv yP&M<шr >Rl^j1Ā8BBu 7I=;h LH=z3Z8١,fE WYlN&B>UP}>"NltdPVd%\ߊ\ۊoZoyq[ϕqOygj<>tBxFLV{8Ͳq$H1nHZ-TCYMIҝ|.e6lͪ!+NJʾ+]%WY~"-TcsUh ]#LSY*#&or֛.zv}ɒˢ7өE8fi5QhRQaQdga Ҙ`"yAxŌMff$@MOZPu]>W-qj\@3M i0Eԭ[Wn{e=^e=^.ǿk[R _#!Ht*{^k&/]]Jte!z rQrQnuU]rws|t4 bgQӺL˺M v%\moWEBdm #jfkVQKLu(11ђjC_@7)H!ӟ{~r:."=zXNRLCYm^<(F4Gw2˯_ƚʊK}$YE#$tQ9'19h|4/.KP%UѷQ# ?/x,/=1*Q*1TQ2A!M4wy"`4<06"h2 Q9>Ub!C6 :NaYQ1铨M@6E&CȎ`+a6j}roSAi Ԧ!@)D=<)xB)F0m8LY͈S/LiaWY>!$3CArM43`&18g`)3㗊)2ExfDsѬl1%Obߘ`SYYj=#PYx'[-Hum_ȶ~2vM?fO bƸ|n-ziJ-GL?{xuMDіtQCl6Ixb) L&1aJǥj D5\$K )K'@O SNouX3dBG_Z,- P݀+DBh@ M*QfOHjeS07Ov5H5#c/O^l1ɸa25Ydg99YdB:u.y7a@~Zqqq}-ܣu?ĊDtݧW-S>zTEAکE'팗13')_7-|xy _K|ʯU^,E^d%^lgw>s>?W,M#lVs_.ɯ',Oo ތ%>)e0eV"@rDܘ@S& &q.{@Ѥ&kf{86VJj `V'j_dNK^~@WBvE^L)^ bM 7 4呻`k0|ud pfR`8ds8drC@_Iףg&x˪󛛛d^"g%%ahkQ vYbTJʐp`n'q̎ڜ~5.ώf4yrY]M]dvI_6@>jO;@&4V W{Bx5oVW(_%NYR>Ȼo,,񿓍Ƀ]3Mщ[t6Zown5O[C,܁;ícTF;sO 틝OujwyӦ >HֽjOOIv&$Dڠ?1s?JxVW1u29GMjܝHCBT=x-I&{ER*#{g2_c+ŒU? endstream endobj 261 0 obj << /Filter /FlateDecode /Length 4508 >> stream x[Iw/dy܍kjvٍkϜJhJ/ڇGOIYZ?8gr'qp\ WKU,o⪌⛧?I"U"K_yA[J[Y6B {fvhI5B;ㄳm#p*r*Sжk?VI?$Mu]ܦQH^һ X.XPmW #sw°/6YY82ѐ__tl#-5 4W:ίqN7'T]QB!ҁZ]oICƄ/d|t69d!֎=ZX`V[ZX 4mX.h/mE`n.x[YK3T=)<8%c[?QiVҜyLN~clI,MxF []dJy[iCC, ,k|qD~iS(k2B;t{ZݰA3n2aYXeA%|q[9ϳ}dzi(qaUтYX4 f!k==kXW|TJ?`ԩI*kD4[NNR &4/ Xz0nh~err0<1cŜ5ZqU.ꟍ T֪g<]>1 ̽ vg|;R3Ae9'܁F¶y.1!_x8sXg1&NypZs1 TUq/d'_.~:9fs_^'zǝ]>t?79.r8 /`HO&v=xpR; j} %46岿IgNW]fE)-h")!k/)YMH!]f=UT CLi2~3/I ^?Q?-hr5lJUӸ(㣊ף}<rꏱʍ0eq`X,͊lj(;Jk, M}ZeVY̚U~uzYC\y IW #m~6R$]JuBB;ݳ>5f68NREP.$̍o⩲bO>Y0*TܺGWcKS&d45+b Nj([Zk]<阱P`Ε03*9L%Sj>N)q 5%3:Nd>+-jL9瘧e /]~>~M]]bZoqQJ@%3Ê6DfG33 ȳMT@0Hj04 r5?ɐOglFc}bBZ<=m;wPnnjn1wYj~Z4 %>$I?[bX& +ۚc14 $[ɐ[?wih'@L1 j%0Ss%q~XGw} { ހ6ggz9BtgߜR"GP2 ,dOzK ]Q^*a+W>1̓ WPVAn6C1p+@׬GfZiWa#Ǵ);h:j3"JiCK#P6RWɟO+)@}|jJ{:1(G!a&K@[YR IVU xFREw6%8"JY }?|yy)?#_g/J^>6x'xK9;եPK]+B ,ɾ ~ 2jopmh;,PO7dS7㢲DFҺ:TQѠ1FڂtT9C-~D|MqNŐ2djɮyJgq63yۆ RrCFF kc,d#T0EG4#c4l_P>EoXrڟ7)lԕHI`׆-2 "wr$unǿQty[#['o$ 2'0eE]E[c2ݎqV K/b̈|8[d8D&BBg- ߸[h ZkQC4~Fe8`!ED;CgVQ_Hy=>=e6X^itU_}˱%`Ct@q^SyEF wzH Ip~ |*-K/?`9B$9Q|ߜIxCXZ7?V)?ݒYm7 PCŭ5J2owя'Zti)M%NRZ.U0quxoĴ+yzŤLIOl3!̚0t8,WgYk{Ʒk:)wgb2M: |}tiXa`!cG{Ǘ  nE7l7] *̝ #1fWE (#K6|o]Fl὾B UN+U9k k|d<ưdd?#z5iGcs\L|{Z/ܗC  ')o4ىWÕljCăNrq:FY$N~ Vz7s` &&od> stream x\˓6zOsrTjrqSxVv$*SFm<{l${FtP{eS_.ۋ.= >\~y}+I/.^pqek+sy}hۊlk=5ucT+_vՍ@e~tjcݕTtm~mJ)Y{gWoycpUnY=6U0M]KȪOLDԶLZw!߱+ը:yyLEV=P'?M+q]J >Mvt8{q^-;{U}H;w#MiF\+k9ްzo LbHhO>̌?!/ڰ"P; |RAk%r.q=_X[hL|JJUk+ΙFB4iY+T'ۡVy]]EC/M VצL̴4`]t2XtԾ?4m;Rd 5nb2EQM8D"m]!;Lje9\?1cnaf z`:=!=cl~,4!ePRŨM|@*P6oN$ ]0_I9" [Zj~~Ĝq٨T@D9\ 7=<#NU^U)nV**ptyq>8ZQ[:=Q (Rs]B{.DT\ \ P8s_F :W$(ʷ'392>׭IhAfD0lкO^QStѕ1 @SVpgz Dı4Yx7=MM:=:"JP$f2AK¤ {ջ6%:3. *9+1 GQ`-5f̸M&YhZu5.TeGDcR?f;ZY)57gQģ4{꫅hL2xCؑ0_8A~*wO/U˶)rh /&j'lT3 sw )tEuv T&aeHN?<.=ۿ`q]Dv`,- C:XDMMe1,. _hxbeg HS (#]BFa @XLX{M1Օt|~8vl8s ^*ʓFZ0 F[f.iH\S W̃d ljd۾P41@W A=ۢbb i|!Er÷atfSEu)c>@a $Y7dǍfnPcTGZ;P O-_1~oEuE(ݔO&T 1NY50_݄V`{؞yدkB9vC>N*>mtѨ7\C!$5Gc9 Co%85K;45^|`nI Wc6q8o *~3qNq覅tIH4,e6:8rq&|Dː 8Q$"OҤmJkE^Α~bUk>.Λ @W3CFʧd@pRK{ ce[vma*?gja+0 ; ۧ9q`}KN\ c 0q/04`}28+fbV}DWL$FqC i8l*}M/; i<2J͵]qKisXĻ'E@2/۶cw?dms6j_Y^p] q(èϧ8[Jt\*$Y?a)4sܯ )"ĤFR_1=C b]%СL%1e2u2nkf&n}bGJ(IXP@7S^:2ifEPHOԡff۴~c+"n5 }zǥ)j^,{Ž)Zr͞!eve8=8&Xt#IKqi+CYƟ51=n)$ȱ>t7._J33.z'%H`eӲ[%@e .ݭ0k->;?oԄOvN6$Y2 X{Ng\GM[I|fQ1Ͳ;=7,0J`3YL K3>А3' "Čiٖ#æNz7Uzk ۶bXV<[W: @麌]ԐP RC؟3΢,Rtc@ͧV75 ~*څ9!'%X-K;$"Ȕ9ؚ!w+v EbHB$ǩtuDYXhgL, ΗC-LS~ gP dǔ MZ0NEQ%| {hV 5oW, ( Ue^xB/\GSބ11g$eJKCK=ərJ<6rzrf꓇ԶٞzU+ 'ݣ8pFZSoEwΡ"ٝ/o7Nj {w}tjU#2+ XIQ\|PT售Ș|a!jm5ǝdpuZ!NLuG±@jT?gcy0HE09\Zގ.aQe3|-Xq(j&䦵‚r%aGvŏԔ 7[7ǎ1\9CDZ2t k1N)DGi\Hm)QdsM5TǗ".8~Cñ}Qzc4(u]F(j7QSW^u%2{2#kW.6u!T >-^tۖE9%} "^ }kiemz|[57zn|gM 2 N袼K i83)c'exqoD&P8}Ҳ~/^(LFnX;K T?^o%ƛQEUN4)NMk@KƧb[k ^|y3dyn798{1ffMkBC!ZN"/x{)J.jQKƬ6**Fmve^[/RtcR _\|O#v=:$'_X)[vLR33͢[ǰu:BPڒ `,iu!DQ7_9G-Ty5gHMoZi7Ae]aqW=^[w& "ݻ7^\ :w|O^Ȏ3b5~GuyEn 1aR@Rqh NU?ĉO"Iϊ)/Q2,/P&ǯ}7rk8xMy<-9 ;gy:ǟta~.vj fx//=:Z/r2m8EȮ8J1?Z[H=bvo0)%8|x%&}Ox^1dV>|[. BѦf+uL!6>aV9yn^NMVt?oʍ, _&=JH\ 4ƒ3Qrendstream endobj 263 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3136 >> stream x}WyTwDH4V`d3Є"iA6QAivEow#";Kb/3c2`4bF1E~WɛsZ_(IL&s_gČ4K&zOgCȶ}BgRVt7@_cte֟3oFM9.k+6 '>Jwa5627u׉<`KEJ%īȕݬfpM`j*\8Z'GVG)Š=Q6 n8>i@⌾Ju "Oĩa˻WOh-2w<ӈiңG*[\-Vjd26溨揀LS0@FjTK|p }+@-6B!"JE&;*$*pdQ,~%s,G=F5O(@ vHOЮ8WSs⭎ T'UH>lpM In%7t%؂:. qKaG$Ȏn BEŎW 渮/qLw'͛F';c3M>w_'*vK苣L:7xO'e8,/Ld0ME|(\6=z7﷔ ;T)skU ,M޺|UO҉EC†F He &k6:(IW ͕k7TkOC뉏oJݼ)$}~>Qrc:QCIZXVV1+H\t3j>oW=;Y˾Jhet0i Fcq lq.a3x YHI:d:FձJoT6FBt UҏX,5=A&ط3% ؃S25%-畱 } yO}4(3uj 2"ΒNfL1AD[̬|ۤ0^ @Wq:j08{|rZ!< $e~QqZ1^&/A6:^'i6h/()X=Ǽ9t LFx8 ėT;UtN$98#@nCPc@׉b,Ⱦ0l#-;Z`ћ5V6W^"ݗ}tOz3mUvEQ%2d(#] Щ6>6}ş[SEV~NB. ">,+KTL4\|(4tq@.YL5q:0$NMgrE46 kAF3¶Y w!_Uz7$m?ak ]p~62( h.37V7›ls6%;^s"'n<*,WSkW ť8YѐLe|qV+!sN4 9 3kC|a~?"z}e+%DM?zY ݍ D ⠐i_0u8MU.d H8xpj.-T/ a5HCt22+K# t:rz*,ۙ bsΊoL8X 0W|aoNzqp S4_tĹ%qX5 F? myÓt> p芯!{4`BόzzZ 9mo&-~ _+` l(5u2e8 JDi,& s"*qm8CAwVdz} dv4dfቀ6C>B7#)NX<' KGoZr8/{Sx~#Jt*)h1_gyB ־{ G?B]STϝK~BT~)KTXJd >i6\0іxʭ 9"G9(Wr(1Gꏎ} xA4r-qUq7N&\;dcz،gAC7p轖Q]<^q-\ԾZU]UmyC`,6)'*իp;0t?߽eoٳoCLnܵ h.uܫš.͝yj9&V_s(u۰{(6y?fx:x/JJâs&~(޶{tOE~Ǔ;?gߗtaCgBk BYeƱ(/ ߪԪQ9j"3[2#47^&ЮUń;y,A9.qDₔ;BpU_+qDҳm&)!./sbHڗ(\CpZ4jZ{&hFc{Lv|6[JX^RwtA5۷HDCBZj+ 1ïdo$-f;*E*a{X.09v=Jh-'sq?xJ2`ӁυP͇ˊ %%FHFQ ,< A8[' R {D %O<'&iWFE!TTƆ#7w_&AlMY?1OT$Nb׊VSK N3wrبu SzfK!gg|꠹y*E/ːendstream endobj 264 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5071 >> stream xX XWDlhVqKLTҍ l. [AveEQi܂L\IԙDY̘1Fs /yn8{__SU]?)cid^ - ц7rfXF8Y&W,#۽3fNo|?U=f2ϦPq3fȑ8\k7DhC7h;a1dːPM`0eV,e˽aq3BgylmnԼ_܆E7n4p˲+B|F;n'N'0x1%;f3˘Pf3aV23f532Of3c3Bf"ļLf^=3}%82L̆Oe,$MIj1MnY.$VUWVaWs=fz&c{n]^սWnߧþ?V+'*#t&ʗ0.F`vRHp}jrEai\Fq>@5܂J=gf`dјՊ*,W\!cFj'#s:*.VvVtj1s(u(s'fO,f% Pߒi49QM>԰O=b@֫G#HoU_ +2t^%G"%<|ÁՇiѤd1U㉫F\)~&s@b%ST>m\8Y/` a֩i1NǤ4duhh+1LΣd҄ā8>cqWO^ @8$=w'Kp  >+mfI0cP FFcYMDUdLLAH"#g,̇W. }ѭy֒YƤ<(Uj e+!3J}fn p"(Nף'hjDŒ&35ط,f#[#(zHVmα2 v"QqX@8,`=s^DEᕯE*>OqFd"^Bǔ NQ2B3EMe(&`-c#'8L|xԧƯl5%EbI+ӽ;Y#M`6d)~Ϯв~G:q#MDUcKsj#3RW,8诧/zrZULQs]ķEVs@O.ZrLcܡ =N,?Ĕ㱇K8?L%'#Uj 1oBʙ2:Rj5FTQ@oL]&*f^?\X58@}'KvI1kؿZ!Z gM1~/(X\gkٳ#BF|ĻrȬTɖA=$uɩaٛ !À8a墨Tuu)% '-^IߐhHߦ&, E9F(/,;pJ)D' Ϊdc#ʴMسɑ"Zcoeև>04e C| IPG}rm <\Ka*y}乙 ջfz@<'.S 4tœxyZu)]4-/I2I:EpL-Zx++ٷ׽3mzځ X嫉C BT8ЍfbI+n-=f2Zv :bT Ƽ8Ue^nZsP}<;bOOKTFKfEދ1qܽ'>+)3%?RTo%2m9 ,\Nc9)΋uRJ^rJ2sޓpVjɾfOIBYP f~@\u$m}\umMycYrWe8izKƑ| r17vy_Ey.TPt}G$ȵl1*(X K( /`M_gؗu&xˊ TНJ1u4?wMb3*8I9r{穻esIfUHzŁ@}o3bH8Z0N\eqQ{j®uA! @m̨-FYY (je^';1wfAk@1*A!!UH:w4}W'/g#:\֧A7wB=@y xΦ=%8Z~>Omt5OhHhqDE#I4ѴSBPQCxZ>6ignc"3C P2X<]vb 8@vmPeH6azA5-?1Dj8)rq%Vj]=pcX+* Ne+Rt&EfuI:~SLDEވ֔NtBG~#%"ulTO ۠ą x:..3S_,w+7;ހut*u/gW h3JI 5z[&{A zQ4E;!e!=>E?/ڗ.n@j<̆w֞Vk.Lt'18|^NJ08VPVL5}|Z%MaH "'*Oln57NpM^ @Ķ]/6 lagbv6h(j˽itȌL:Ft{B~񓚸:̃Id@؊j)sm'Y[ݩa/}3gw9Fl*hg6t&²f5PITu)-}\\SBjXF*[E{τ_"I;.І|uMqUV1=N\؃ d0Z y+\2 ` Q ,Qmx QQkx(6f俚"YFΎ^9?a `6Q6;s]Ց/k#eXCrAH] ݏRZoƄ O<Y$tXi+֙ޟ{mPP^Hǭk s ?~OMQe Q)^$5-_@{݄ks`y8/$.d!oI\˫V?+Om ڲppz1 $Uh}oa:%s@+h);z'6>˘$_ \CxȀ%|s? vW-(kZRK5\TBe VĐD*[y(wk2\#d]^ȝG,= ZW"M @*]Ʈ̴L>df1 $sQX;-%MWdayO7VRPjM¢ؓQsvC:c'FuM|O.%z0݅ڳ=`7 xVt8Kݥ"ڎ,&Z}kV&j@k~ɋ3K0ʱTY7+vyiK/w:7^w5sv;SϢh_B ;whEԴWhBh/74t!! 2}(̄Heװ =-IMXJV% FQ a<`O`'"T?&2FtŤ_홒Af4'gZzthwt-=Y9e')5f?68둬[x g)lwqc'[6ng >vT9@$Ej w\A[ a"^jG5^5,0Zu*:e \4b(^;w'OYVP۠-Z|LTj؂+;+O5g OfyǴ~5 !1IԼ9m']k&?y}i̷؃Ђ~MtbQوdt>x\!jb9kc;);UxxMtd%!۞MZuJy}漢:'Bk>y64T;rS>3oR 62G=yտtI 4TTn@ޑADaMAf/:_r# UvVns7ō!Ӧ}s!{StQ>C9 |nw!^.?7  PDϕBZ-\=YsںJ/zp# D{j/L#h  VNp_yXoU6^X zпlK2Lfd+DK@_7~3* bZuQ~ 덅%@GbE7c I !g;B+/TQf#X[. 65ƌܜ;MY r2yY= K Jendstream endobj 265 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7942 >> stream xYw\T׶>cWƑA[4 XH e`53^D1 cnbIL>d}{ƛ{{ggo[Z#(@`b l\C W'@# h5e5[ZBn|jM>M {[L0aqL p ˜\‚[8nX6~xU~av~ήNn~nk]7X.Xlcmv?mVZZm `aࢠKB. sZyEʝVZvn{tIL3m>6|D`)j0eM VSjeC lZj$eGQjeE6Rq&j5L->QDj L-P˩ jNfP=(_'GzS}(SJL$T?*29՟@ DM1v ՕttVp NGl4&wښ~ɬfʺ:vujq=X/^彇N>Mk+) blA(swsԿW6`рmr~+~'baeQ8(d!Pac3gk,ph#o :ikL`ViBNRZDR]~opeb韵Vp@}V!3x:QDs[g: 2$8D]7M8]GU|u?^ []YY~JWZ|x77p %-D Z"2Wr̕Yv6,.ûڑwk:"Y3:굙` -0E+5f]&h$l7?P$FZ&ýCMӱÐJTI;̢"pdCYGdV#Ch5-6~4~' :Ae3,佐}Fc%A]P^"1;#]`cpN8td![˷peU V G{'Z7ݘ#LJTL\#񙠁}AݕV p?ro!%A׿BTI^7Npj0'ߜAp87na8)Ʉ(9(bTlb1 Y7A ~E$h4&%2C@<1؍nuslx+vAD Mdu0 XoEM^Gf|! WxcH{C ܺpygtd 0//D6pkq?Yj(fP-{h.N&TQFQQh"qlĢhlD?m fxt;^. Θ s^ޅ>Z/ӌ 2N 6vU|3 3x4t2L} xEEzcѨۍ7MYgʐCI[&=ꅭ(K( ロ<杩P~5MGrDߙAkыPIۅkQϿ jfb HZ/"#r>">8 \(mU'CiWM-ߤi@ah`Jv , T}a"2ť^K ћ͒fEb.4 hsœیZR=|1T*ꀢm>fɱ T\)AGg6W'}vGg{VoKwJZ(eUf)Eڳ(! XebLlҵv#߯"DVP*%>˜g`9` >\NJQX4EJHvЇB0|ړZ5%JZsjV&[Ncc,[7նƚ }7(fBN$^I ;)x2uYN>,`2 =O䔫 O)}8"=B%gҖ>nKqhʔ@jŨD&sp>f+lG)ġ=?Aڏ ?7/4Yw2N䡴WZƻng 'P_,j_nC-Q;P:>~OursM0. !Z#MS6/x+Ǝor 4́KUD};"Dqlegڬ{l!$m0=r32|6`=׹k"b)PB$_U0L1ԯzUV0ؤD0.ƨZ PH*(E1/C" HIrgFr&2Cw Er&Ж^{&La= M^acf`f._S<;fZVQ{4gM +|m\X>Ek.bV.N\V?;.ɹf43@(rZAh%2=obl`;a!O Rti #fDA6#w i66+ej;WR{ޣe\]ca5C XRm-Jң"G%(VΑ)R!//X͈sISPWhqԪ֯Djo I6׬N RSJ)ym|N^U\tyNa]l.#VIi+A;\lBuȭߥHC N5jtjtݥ঍_;#[C0b7p/ 'J rY gNA (s-wڀ3&ʰ0~RgIFuW{C>,X~"Ӵ?5Hl9',.PitA;rEIg=T;I JJUR,D̤dyPOztF C-Z; @$KNA>S#?8,$ǡƳgX[~:G y}[\OF$1$Hb}/vfh*de{Y(&0`s>}>Iۿu4$U.,*Q^%V#u ñ_)$s<R`?`hQ +d|F2JJ!5mzrRn%Z> 7TC"!krұk#f*B=#]r ŷDr>TV.趙 *yb9Ei,^) vE3^V2yvziO`D u-8j'?eϋ#c*{?=2wF_ u;B?޵e_@?I:q@ι$b <a>4ʦE/^̏X`Ay;>"'^v^w% \]qӊ<~dQ,<%u'[fjg8# $:R» ޚ>mQ6=Ĕ/g lik6i\,]$._{Oq8-\"fU \ ZqE'Uxbܗv7N]>ZmioUxƧʹq6Ƀf/J<}cgEJLOdl?wnuS+:Uf(}jZhkNrۯ*Kd$ RAƫ `*}D2`n5pI:[ ,Kǜ ã&$z mFV"!<* .(NHRmRlkjYзX=cGv.Mۑ́Ф 4KC*ym=5eoiя( *ruiAf +ڑIV9[bO+qmRGx \K?UC \ /i saa~AN&@_ 8/z2^Ɵ@̮\> q1YD9ӖG=2'|Jw^A~3=_;3"HOc̮D^D 9M{bO'mAmvcyxG\lSn2Ul+Z)z E*oFmh)%Nb&4WVR Ѓg k=S+U],wZN0C&F' plޮ Tũ!NFуţE[&p:yE:N~)}3ێ*!֓7 g͔p#ԈXa\/m7FES ג 5Ա4:鹟 8 Vb+2z9m!/*Cu0cB[B3q-mkLm΢)QW@n|LP@lA2,vSV(ؒf_M4{G@\ !.7MMMfO} '@%=^n\ J; Bx]0w=ud COȮKo8VIkb,i 5*363SVEjF m`Obli1~9hjN㖃Y޺m_Ds&&1(_gԼrW=Lzuի}8Z)SC$FRvѧ.| a+-rJ_;0aK?ؙOyգk#/<&`qNнk%-ja)Ac-k˖,Y̌SwLge_z7!od"0W:pQ(XURʰ@RnruW/ɲ ɮe3ek + :yNg=iv> 4^dz>9$j1cjv6BbdL`RiXE囐VwZdbzM"1Qpˑgdu pol"915ٗH|=2MqK]v <46Be> stream xcd`ab`dd N+64 JM/I, f!Cßa N\2|<<,}O=\1<=9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C530009100g;}  <6endstream endobj 267 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5826 >> stream xY XSw!^jզ{V2.ZwTPD-C$B$!{!P6wۢ.yM?=?N>> ${o;',bbƯ])=5:mySz):%!0=!0,~kРMB6o=7A"㵠Y+WFŬ͍]>>$aCb&~hr`sJy/!D1@(@6h(/GZ17>z%JtF_o6BVM r(@UDfr*F`^Fɤ :mNjմivB%ͼL<G-%d.<3T94kWjJ1{#9z{>ރFi0׶緇 (Q~K$0K*-X,Dw+UG@6@L2V+ OfͯvVX,T7z2ט\^W4 9v2%t_S9Φ#_& 3_at.7;3y΅OVZaCc'paQEXa*w#i@̔n_ƕ4Ct'p#mڀFqۃS̻ܧ_Q#0ZFL_AhkwXw]A+lpLgf>qa'Ņ'!ia[#~Xb;ih u.lwz_f(&AgdQ7GaL6#e DpBGUE*%(4V%f@>~-:>?̮"hh_CF}E15t[7; #hȶD~%=|@@L@"E 1h"K#{ |)V0͖rz/iɫ`hM3㘕\ifTV 7oXzJF?< M ftzW n/ cf'log5xo b.=(LrF(^Ʌ iLȒmz-E 1p|a$3׽AA8ԍs{_a{W :*62Tjf1{^2j鷈3|E ZFjh,O |vS (k|sm@9O}-C[Mt!(.WZdlPA9yr-@iP(43ybxvsA}#>1&90Bf_g{$qܾՎ?%Fd)S2Z,Vu S %I2]ig~o\Ca ?&LC p[9 ɺk8%P+2@Nyu bV1#c愿|IҤa3)x썦^1kU%9YyO'=݉/EaP ת65 2VN TJt5$M^GŅIぜw-=!<{q4wu4ӶݮDX`6:s~ \õsp!Y6 ۃt *w{M@f@}-M Ns4 `l*qb%Ytj1Hxm};Cyލ}6ج0@Bh٦0zEAg#;] ’x9D[_]EKzxe}+u ϕq]+7y1႘ׁ}f5i MHܓ,hx1e2=h" 2o7nM?VS[Нq¾?wp7}5Q=!Pth\͌b23 @nڱ#g?C qu/CqGן;t'h)*\`60{;B(RLBh^mUoyV]EmRdj Jx#H7d6.9 3>Do j'+j-KAG4vj#D36>u9d:~>s7ETƳq@ 3}uvM+k͚ SIY}n S*+vt[a@:i`7䕶XmPF6 23se:RAUo:*k^4'@ X7PN;ho:͙Oo{zc{bm=-PAƞ!msuXswufgO+E1{3oGoD<̣lЀ,z|@֥1_pJB㥑ZB-4k,-FpfT&r497䁲 x%`^~y|};1;~ Å.E lOC+PSQ EhK- PXkꛚГhFG9œMEb] -ϫBNW(saۗ -*i< .*3˅e"\oNL`/hu/(3hy)wg4F=K*RֿK.aZ]e]lOhtjMӯ}/ oLh lt*Ğ\Uj&S*Ō R9i&`QP @[|xxӛP\@Sf=it+9B/bq._&jٟ:-t2.<еf:3c&Ȓ , Y3C2ُ~@6Sv ޥ,4 O ٳ> 3fb9̹(e#d'2- V3E c4P) o}M ?x;"OyDn4+::lw"wLmL1aW-H)s^)]'QD(+k1A5ʵ33Is:n*ǜ HiEK{gm8HdvzӰـ.Y>c{,b3'xr˳ '%R)IsFSC,%q:t>/vG,jª])؎(1 !lK^95[:k{NAk$ ud냯#W&%P̬:N/jJ*Fj?Z>*[[_v..E/&M&~ŵh" M`YH46 tjTҾh+S+W`xL /k踄'^!JBiDĞ`zR߼95-"+ș,K`1,V0oj SON>J˘;JJ:{d|}<>3@akkz0Pe향)Et҄Yx5&)/.VzIRAvyNskZ^g Xh{?ډrYٳ5-5mRlE~Y^+[MwlJ'yo҇bٛtB*24B~(ܵtmָTe꣒|"!qdC"१-[v9QU+I8U48LjEo[)^ұb~l4MYG ) [5CUo54Bk%-@ke(`4RCQɐxL?%`> stream xYXڞ̎]L53{l @PTPR{{,d5j5(Fo4Iory.-zsquf|kPz:D"]Bo/NuwtSpxKwq7yX4Zֻ< 8:vt%{7=܃M-\x<9|偃^~aA^&|Xηo/0y.6mL6Yo߹j5EQvf>_!pcЦ!aȜ8e7wkO[v>s͛`aQ䋗,]SWL[9}Ռ3׬}w{KQS jN}D͠ 5ޥvRQvlʞESsԇ<ʁZOͧPFj!zLYP)Kj ZJmQV6j95ZKQxj2Q,HEq۔!eDPƔ.5ң&QdޡO ʄIMFQʞ DI;::nm{KP_W?֥i/3)`ęF>yThcv9>v؆q8q?aք*K6v'zk[9s|;paM×F̍2&;iƤ#&M~΂w@apȄ398b1u԰L2 3 }X*)aFI-*N.N AQEx,k黅!o:T!B7]6?O5+CViwت 3b~ "y'ujfGgUm oNGPp8 ]b̮K 6lG/^.CR͸FyqfeQ4h+lV`eF {b"!E45tz~rWFG"ZT+3LZ}@5R8r "ԓlR3Y > 1j JpT|(BaT{nUsam{uyJՋף2O?94 7z b6?a~mPqv,1 Ӭ޷-RrU*] 90z0\_1oejffoBL*N&j=#4>AΈYw =V-@U2Ţ@Ϧ}U9bDlbJLTU`Bf$Fm){ý=xUsZ_?3}6Ā?+l|{ kܟIY.߼| ?U* +,Y 1f/j!CWdz0| &LG|Ǒh/i& }/k܇-G2(wЕE ;z3ba6|vZ^RM֑Utios+VYyу3k-%8iPuFb W]*4߈  (0_?t!8 He(:SI|߈i AhV=7M` tU[Cv)bN.ߵ%|-X~Ѓ; ź|0W#1OK &b7`!7_Fu{}1<\ J] &pWU{eo*2T1 m?~]+"2"ZA)ybTd$ԫW--\JxWWυ{m )QK-D-e"rZEm_4E pZ)9DHZ rI:9Cu@,;nc\Ȉȉik͆&zD-K#GOǓ+6QWOV !(L+X-# |c T[Y#f-T/@<,/Lf%fnOq*=3{:k'*p'h+(PEr#vǿ>l}+54*Qw8,OU'40ߐ[֤_΃f_P+Uн' :yvULGkJ #6LrѡOaGb^RhniKgOn959~tRS Y GVp-psD fd Ŵvb +AU>-+%'=/F0l[\Xa7\5:hi5=8&0Lp x0c+8_r4~  K?ojP`6s 5T 28 #x<^fm~"o;׋ p(LJW}Y)`ԗCPҟ QAz 5V&]),`e(m{P1t]br8)=J؍7?ېCmN'WW'V·D7`+ SYq(!c?dD_[te i}xE Ϟ8p`3`T%q~˰vƲ{*]A5ȸD>)Z 1>&RᓪxA^)CL]uyinǓ?TޟM+P4ڽQ7L&lE)y\ڦ.Hv:Yx)(-7ɗܹPW䈱xJ`I}r:kl3ݰj'PH ¶Yy.ى9 EEd| 9EE_BKCS. iw6D\pnCWu"A2=<}AR|wcTɋTJ:H9oEgs~ƒ9 l&l'xv!χ8qsέ.ۡ4 ݄(_jqpTKV15=*oj}^~ 7 㖢̣S/J2tҀ'YxB,ٵ3" 1pD@o G͙ l'Lܳz~=Lp%]rwQOәAҭF5w&lB)|`kM#7s k-F1b.'cԃ>+<[|1z:Km˶1iHت]BX"Wݷ5Z~=3AoDτ;Ǟ~ZCUeMgR5.l%X4^=R' >d`={AZs);F;MS fW?n0h&SY`*ZkxJZYXt}<;*t7ize=Ke+b#C|&"uƛ9M ނ~gLPg]ѹjG:E(bJvjllIz 2J 2ӎw!{v)joh.*V& Y.gd<{;ӗk1d,S+ڪ|t1g bKs ,BM iPPUXk#B0bt>!5|1BJ剉߭{GxF[=*݂5(Dd|*}"#f'Gjp-?i{;ڜXIZч~ ȃB0>ɋ\HB;Sml$l]'Ν-\*h_2 xWiPKaI+,1d_jZva]v%lKO#IskQ5Kiv/:ΰ/nvh"#WX[^][T\˗=1bo,l'$%#Zl6Hu2ҺX%EM}󞆭Y PBzF\`^mo,s34^'K?RA.&晔Hّ:m#3nt^:H<+9n}*7K {6z˫.I*H[[OZ>"xYD!˨k?K.nhօ sbdU!Q^3oG>J)Cr~w> Gk7=1σPrztG4RF"7sPP>*[71o-jSuGgUxgw-gna:q0 ?;sVNB=IbH bݙI 駋@ҥg8<~ͻsܺ)B˲sP9S^U(7#R0_%gzJO?0jCաyIt‘]3kpH}CpK@TQozLc4wA٧t80tǡd ?B x%Xpꩦk +X a x%Hnq!i{yٮX]Wxdߩ)(0wb- fp1ǹ&bNVAeR-XUMZ[P}T c+/~08vpvGEtrh- J?>v1V'>m.n~~]|NYTBR<EjO+A=0GA .U=.9fs<^iGP+nsCJ\Z2J4EVVfǦlk|wݻ]wup}y/&FtDEKqq}nӕEENjD9Tdƈ,HﰋQI|f:ʢ~غM6e7~!{(V8]0@Ko]7tQz5vt?צzіtYP;ǰMםK'ڎeSH~$ )NH\UwT- Z țh}!p6Q/<=I]kh99Oùڹ%w|aѹKBndgI0P5˃w*!p-w%֮3WSM3IxgjQ.짙j6 rwb$OU#&R,#w8-0M=2,?S_c83;9T^GAߗfR&/*F8:~n9-FDv?tY:`+ Oq񪋪r\1r; $F'"t9˥\:%FG$M {A L K*LN`9r04 $7~w_*_TB y6kCq(.wr@ fSὟGәmBjZ1,b}<]/Omx=cCoL}sYnn<'Ϝhf'{C1iM%@]7*-ELj>f4(>Ay*,2xLݔ秡Dd%+L*&9 ف1I(8ai8yOxk՝(1U $f'1 ;DВ?HsDs uԄ]]Sa=H4> stream xZKsF=un扙TAۉx%%dDSIB B*~{f*K<=IYI,{$ZO_|s)\'O*]NI;+5ʹ,J-+^:6%S)5kڏ\~ti mJv:SJavZ֋es1Ipv>Xeu\aS Cjv\wutE]4~iK!L Qj2=L,IX!+`5|I++cefbazaObRt˙6R|HKv4ŕ[u:znً󸐊ƸikT>B:jTzDUfj:,TN5~1 YNڬ68LتLf\Z9Gޥ5l1\=1YW8aA{L4gBfo*h1:߿_g |t%.}fUɀWws`dg g Qdqm`45aۭ|t0Pgh6 3ThqS564}/ik[NIdc6z%TQ aoݑ5Y]1ѡEne"S|KF`!{KQ.a>ǑBO0~M;R/ DY,-5F8gs |aNvytŔKG88E!*4ct0dXNJ t5A+]u˫>$](ϗ"JG l^|P}0_ 7jBF3_EW HnYm3/7y'bو H:!b< 4 _3 ^ei/Tʂo^"B5B] %kGXkұH`)+ WO4WFdwѵwW78aX%O´PL ^@{@Ps{F.I8r\ aO':( MIG?G}QpQHKʯnGg9 .۶0ꊦ]|suO7E?$ia {Bq@JʕN4/$>^B'- I3z>ZZh:ͽwp*J3ޮR=,[";i` ARǪ-S/Yv9b>{ oHI, 2'y-{p} ~vc RQG>%mXgX1/7 *vP*Is$ܕņO r  /{2T R ̛JaGȻwB:C3vOힲh8lTb6Q~V ʄ4S[ٱ-W{oNeQS7֛ax |emʷ: }vXC aٛTٹ!Fc>GWVg@|}*!y!NC5EIKm CQD"AO> rc+M#w} NU#1ԘM 6P^'Fc65@{;S#3I]O Uݐ V?-gS2`gx^˧&. IӅ?|bR)+.h&)S߳ǣ)僀kwwiF%{iqWDx"FD=ΐ8+a6.}]DQȽ*+4^ܒ A$Bt!\ e2 F fEI.<=GCh}xs}B^#d(? <a#xn頶JYvq`eZ\4+wA퀫gqsw[XQ~_gljUzr q)mй π(}Dg"Ȧ'(#i+82Vt3U`c< Za0%qG{v85X9 @:W?d}Tçe(i_ޒnt"8 [\$o|6Q^_, g܄@Yp b3Eӿ']f/ cFj2}sNa߶GeYzǙ g r>E+[fyZ0E90e8+UIb}2hZBp%KY/<%%=ƫF|ߢ8#(r`fqM3鏇7C!٬}EI 5i $VBW+đXڬoY+D#uqss<*Kxpe:X17]6_L x@TPjKawN,}?c%Y$ķej 3^ՉvGx+-(}B&+*ypv_/5}u=o逭( վ@eYzCkFa,%㞠+c/vguJLC*N+7›d%]$ZJłlGB.QfmW-3(wZ*M$&|z=gtfJz+r?wfmUҙ/ M33x5aQ[xQ:$}N5?:ʺ)QaCbRxү8a|1;w7`Hy 5Yw\nD#P&xg\0'm\|:tA[f=Nm4)A׍r%2\r֍5)Z.؋zIe1z#h՗ܯζFiyBXhIػO,ig4z Fѿ]lm$v'eƾ.wN.=npE2\ ʏsŦ۬=JN.2Er5iD$;^˦]G q'VF=||fuZg,&=I ڕ`#NOLuYendstream endobj 270 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1085 >> stream xmLSW'b)[tyH\D8 l H m-0~۞ 1Lp0i| [Ɔ2cdKو,.r&U?Mafeb~%cC^EzS&CIfUQhp? ?fWWǖ\hjX$x8h)ki;t\]7fddnؠM41`^k˭bv41֨:U0ՔU*qD,*UP(f)W$,ڎ8M|RHH MrHJJ4cf*ZIzac69܂\"22(s[ Nx2/ǝ~uxzU)iD^}Shb^+%™RzސQ-Xq*4tM?);iP=4N_i+9c(;sKeg2uTP~zjőY!~gi 3q-ws"pH. %Jч~(R=*V7۞57`#h w?D~2@}s]180=="Y\ۈ. pr.?PͳFDщ+ewS:s' ǩ47M`ib\Iw+(&?wkUWEG=J>(۽V80.ZiY4\ 5ݢ>mw@Y }J~/ 89,{1VϦ] eRt~jyIwuq  endstream endobj 271 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2573 >> stream x TSW_OET^#yJ]r@XhuAED452(d1_([X `mm-9uj{ڎS;Ne:9sN;9~W@P p̌$e"I025MHN2?݇R8GhIjrت''~PTOAlơ5Y9i{BB/\H`ƤI[2`|nR7IGGCbd|}֘yG)bak橒6EG+SVjAQOSQT4Cm¨`jN-6RKdJF=A|)9g[8[NQG\0E_3Ƅ_>9 <ȣqW/qmӬXK+ۆo<9]VY &q?H+xFDZ$AH!  d[&7.\AN!%"tO꺃Q]w']^TTu|r#izgxlGShi4f%йq~C,0\ }!Ѽi)v4hy8SV%x0OF)3AS& 7ODO,O< *,h_Ki1] qʗ!R;Up%[WYOś9{ĢmT(r9J] =h4:,13!x[pT9 KQϦ 5&EEZsX=HiTѕtn>ୀ#tS -Gv ڛ"ex|]pԂ%m( P(~S1-Yzδ,TnM 6Ϳ&}P =@ճ=B @ɟ`pV #WS%ֶDbpUHp(b*Jdđ^8 =3 Vm](XZ?Al4Uj]>x CS͛1Ҹ)*M+v;YFIEQ/Vޓp\{yhhgɋ$p+zJzSRw{z/qi9Iz4`Ĭb0h %ۃB^Ug샶.].{4`A!_3Ą.#!w!V ;t8E}A>Ձk v $ ^CkY0gV۶!AL3=ɜJ YI335jR sie$jSH֨oG#ȷ꺭SL3yWYaqIa9䱶, n\]ܭ Z_96k8˸zoǔDݟSLPB]K= &[}sy_akybUeNvȿwĄ!pxnNT.r,wr,οu^ S=lf88Z|`mjAā5}c\X Cyx9>oT34-knk\Nb.#!@Lo[V lԦtvmL~Dnr<%*-J-P i$> F^=q#  ֲ/1 @$MW ! G;,p^bi*h̀t٭f9J6rm' (f8Fy&~āT1$*\ 8|F8Ր1F".px&)D>p Sӽ^R3vLp>na+MTž#xOM@@ 2ݨ|Oפ{?EN51,>`_- #oGhy%A J)uʺhkˣFPH##Tb4U.~M-Rm.g|wNl2MfFVqfDQCendstream endobj 272 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 354 >> stream xcd`ab`dd N+64O,,M f!CgO/VY~'YX|<<,+={3#cxzs~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+k꡻g``` b`0f`bddI?SUe/>0K|o﷾3{i V[Cs/~7b"Dk\~sU> w5.| pB\OXBBy8yAoMټ~e`0endstream endobj 273 0 obj << /Filter /FlateDecode /Length 233 >> stream x]An0E>o'Hh6aQT' ˄Eoϟ2da(yg7/v%5ηٞYٔ4vV8Ï{?R_kB9:Gi"%k_z4={RC@ёפ8 @=cQ^Fytvv7@7hM@(e]U^Z_(QEԼ$\/:We=w7endstream endobj 274 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2221 >> stream xUip^YX,@JU&Pڤ $80!|˖e[uXJJV%[%l C $8i;iҔi6ɬ; L63~|=<D߰A)~W(/)X0+`mB:Z|Q-nǶƦȞ=9o֙! gMC PX$YѸRUS,p,a]"W,UkJB7|UsXhoYh!lĀ[Lroӳ:HMƊPPjuh6S!x9n =^nEA3 J4QV‹|fo~-/`$>pr7'(` Ve kj_DY.O^;CNݭb@23|'pv0|tYjOH$?"@TA͸h7^Lp @ggPMo1<)t 9a7T&Ur ~ }OZL­~B 2_mmOGW%#2cȚ띐nR@Hq-*:rݺ'NRdD< ƣ}>47 2f^ 5xO 9PxFOonV>'ST ǐ}ov>nRްF Ŋ` ԵuЃk=M겼7G,W0v EpTEKscHݖVno"~:NI/k_͋W_Wνh^J?|"_r`7%0^ >Y@s{Pƞˋ嗬ͯ ,uhMqRJ dӆα\?ί-7XSN7bh :F3'xwa]uv>qpG a~pMH>=!hWD3>93"FcȡvMUUu6p8%on}]O]'O~?7.D\gvgsMO4iwzFz:\g3-x񀱺/8Kj$W=TyC|I>QTcxwPK]+SWl e5Y㓴n@ =p` zЕ5n'I4VN ,UdbvNnmⲶziW^B}_OA>p{_пu^{ȼ)@jma %{2[{n?1;k{Vh&6^PzKJOIَ9^d;X*JXf8G+B4@#M9X۹"\ c)8@ -ae7jI͒'[@N 'G3?ivt(%Ҟش}ƌv3t3tv;SVw԰kX۳I+n,dl)?YmVT*7*SVo*0::!dۆP쌯` M56Ast"nTқ꓅jUUy ahP8]4{p}vM"F+}6TD'> stream xe[LyiV%t1.E1T-A  K [@i./!lI *`"F_L4>513OCINr/rC:0oI蘿r*uK]+uj. TIҧ ْy`3X0'q+fa _LXPmr8^/ X? I*_sD,rzbqH*1/T# TP J;Kv.]߇ Ν_j5!Vb# DZ5'dfB̌.f5 uIbM4A`A{;6Nj-쥺:(Y7aZQzO?KVaZδX6-nTV:wtF^C۔p u~$M]Q yz $ +IoQfh!6(`/X4[?:%2/2>AStݲ+m韋JT*wǔEWoendstream endobj 276 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 940 >> stream xumL[UnJ-HQ)w@&~!H!3"jdI;(-U =-Ce2ɘX1AY5"ʌ[?/Dcbr%y?h5amގ@)).jrlݛXaFe)Fҵ7}{smE#5Ԡ]NfȄ,cVwp02>]9veEE[)>Xo;z:Xomx$5thwt\]|\,o:r1푶;\.t;Nor{|8$bƄʄaS- %&Ib`͹w]{6u^5{䐔$c&ߕ92SIJиt%c칫2'3,zvjȐ##oE#ADFѳS yuendstream endobj 277 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 486 >> stream xcd`ab`ddM,p(I+34 JM/I,f!C[wͬ N\2[yyX>]$}  *23J uuBRWbrv~yqvBb^_~9P0SA#?O!)5#1'M!?M!$5B!45(X=?4 XS[1$ RrRJ2lcY.}_T(2u.00,NwgM_t}wbStwwsLmn Sۣwqo%cZ~n7G4\`~JEcmuC~w-LQVkR-L`yRYN̜.;ߋ9PC~j_f r\,!<< gN7i}'̙Se`( endstream endobj 278 0 obj << /Filter /FlateDecode /Length 3943 >> stream xZr6}S".%U[[8Qũ-gk$J3C(_ `fT҃8$.F _|Ŀ+/~v?-_ o W:z}e7)O{a ɴ,r-&S)EaExvFN:6 俧LJg-0frz7UOeUX{Mp:esg6*av _๬s,eW[^:NVSsD,; >p6\%C\LE\W^lL1&‚bTʊV(Pqfr;v ڵCsN*`qs/7]ҵu|I[ylh֡of,'.$Y€P=J~ygG*f N5ʰ:mAOy .ˢRNx%*aJņG#K)NX{A$MۗURjEhMn.~m~,'tT,Sf\BlӁ``=V kWhEBZy>KMR@pV, _.+ $)8t=|ӝUj Nٙ4`)b]=d} P$bQðv'}z6!XPݤJla`S V]*aH\yIk֬_TZ=\r`ȝ5K84Ceh 3z1Ic~ >nrd(h_GH Շ1FD1z>5sR]Z&jLN"0 hDx!:<CӦ[/.Ⱦ͢x2mB~A}r@ o\\4D;AwRrz^N4sЉ|ZVd6Q!됋;a8n34QHL a;;0㷩w} 37+طPRJnJB 0bټf'zT1Ȯ&8!¸Rt;8w)y~G>Ix`߷1 4c$6q@G6#ċr@Q".ӱ7u: YcNB˸F܈vwwDboau %ʙ8CPx9F9dh%U `C3ArW3 JٟeRs.& iM0+R'J"IVKyϘVU!t逬TO-pw*p 2.@=D4h۶uy\_o#=Z׳DBԿ B}!xC`A"ioXpO @2| ln?{2؞C,7uHA-}[lYw!$W##NS,2E}x 8@*Gz]  :yC:q,*t1[1Mr_Y^h`1jn:8byQܭ ~NUu7wg+l[4DT݌(ډ yp#/#Wɢ8FҞg~Й>|qwvf Ƈx1G* ,ᶔ.=p8 InFF?CdؿWR{t<0~|aڅtܨҽL .zn|DSic.'V%m~+eL@1?$pvIfÎwztx 0x {r±ЅR^O1i"P_t09\$9Hn6+^1|\zڪ*-C[ C>*iSpZqGuoR=މӒec"{:ا}輮Fx+H ٷ(#J0.b4Gƈ/mhًRic?" _~fo ,OJVn'7n򨨐i>^b|JLqnHE!㋷A\˄$DY*rBRjxՠ^SNͩp67ky`dyr7|C]n}q:C]@geWC_YDú9z'HA ǧ&O>J 8Α(0nNe;K 7݌Cw@LZƮ tٍJL9!a{-uyɒN4aWU9r{+SX?8OUsQ53atŖ+[X` L7ey hM>뇮Vq{uo<Ē(>Hp,V ˶| tLw шǥ A=Ϩ֯UGċ+Pa+v^ q__WsP5c^#Xڢ$hfYmsiXF+V8gP+>1xZ}֐_tNjFNuendstream endobj 279 0 obj << /Filter /FlateDecode /Length 5736 >> stream x\syוKLDO4e{9`Ր =0v]:hwU)v>\T/=nvo/Z~w]NZUZUjS2뇋?x_UeepJ)Y6.KśOبQUb]7dt<4TVlw_tq])S:k}~|Z֕.oU)J: ӛ}fN6Mqk]61.@F.t5E.lYG0'jc\lۋt=D>FݸpH/2x;BOn|Ru!겪*|^BcBXht0 5c$䢺0Sԣ.(1j% /))M~>[X|~(ui@n;/p9NHAi}R_~˼o7bD 1HOv"g`U R06Ad x=kڕ& $z, tSL%'ЉS!FM(6VfBpNDZEfև.ībЙ%aHVO[ďLODkABurD-"{!Z#Fc?vE2Q}Gx?mW. ֌\|Qj`ʾIiG] LArb??=x"m ߆yf+tUİ9URd֔"$ wƦ#8>#ǩt{9pJi vŀwNzy|j] i!r`˺T h0"х&%;ސ+}(ʍ3aFTB&Z7?iUk#uum35\9*G4𚬂-eUR:PT@,Bn뙢Cz R iSYUzq bp"_HAMy @e¾'ŇM:MFeG $'Y.\+qj~5 Uk/Z2TY( YOMLfTٖ 2n̉Or fY]QL1o, d!w'I53y,l:5O|mYykͰUah+u5g 8f@9̈1XU$6o{p~sĮgW@%cbॏblwh{xD X\M)Roِ{Y[21 z4AjCaAr7)f5% E9Oat*Μc~]<:z*ohH%51v; z~2ay7(Ws>dhþxNo[e14w](o4cJ͢jhOIrc# &JLu" *rQ#" PA܍XJ5DB4C0d@1x8qV"ݔ1;}umj>ojR&:I> ۵HZPlR.C^f j9'Ԋ~&"9~Ry'a%)uja*UZh}d<:]+vT@Kw#\8I+ZWS{6H+<6"N0x:]](ֽԅ4NH}h=XF3*;+k3[u.7$|,iUibGÄ"c*VQ1ѫq Y.&]F>EbggT&4H|x1LZNcڎlr aZβasQqSrhٟA2c"b0F##",kqk/gΓi])4\$yV.$u {`"47_?seAS h,]Z|&昨J'0eff!,TVK*X{)3S3YB-e8KAJ2a0gSg,({cGQ?WAQ ogo(N5^dKJSIeЂNxJmKyB!c7ǹnw1jL}K@;URsI!z?ΒȤJ9FoԿpu˫9ɐaV~}Q2G7"C_*oDM_=v D<46.7'KfmTf[2&fh4 ;4:`ltb!Ha$E"9liqOы[a̓˒ˈpBI jg*Ǟa嶻3^>roTEpNg+8+LףF/yHKVg'5qQeG%("4qanl!OQ֯*$^^ )@|iJ{ԙXOa.~Vh~*L[DtEuo~V#LyRɋ1i4>d`.u2w7RI H:7~=IRo8'ه8 5#0CD˲bJ:΀w/3UU=:Q׀rYj5su}2Blc>K|bPL RV.B,bvi{)G&ԐrbE abbwbzB:5YR 8&..= 9!#hwI" VEyԅbd"WKa䫓ܙ8:{48trf"BI4~%4b+)EܾD{DPٴp,+ZE7(Pd цoN,eętO|k4U[cVD)6 mŮ8X I> )97f)Z^k+<ۮ/&NG#l"tWBJ:s[+KW2XV]_Ip%W96O&S sjP6+lP*Ui;QB֎VzP0+LJUꊝJ+_VcCz oXASbm B338hM ,せDYP)wٴ0S(i~mc [~h#+8ҹ2LݚPnZNqA/9"a<f8Lc1|2xoD7~E |YTZutQ| 73 i0_OO;3иqZJ Gv˗5[HήT*x(OTק>M rh`=R%4BL%wpZ7PRnu`kT9XV&#֢X5gxα{Ua& #yx=?G}<.{w$l `g)x>`ྸVpWOb; 3mQF`q0m=OCВz*'+ͧiԫ?{޲}B9evEOgy?lu#1yl1ޅ4&L%\@?e*)\Me*\ h^}YÓWz]GgCy%hPcn=2W`CZétnZS`ky#zendstream endobj 280 0 obj << /Filter /FlateDecode /Length 6321 >> stream x\Iƕ4si}&X0rC&A aMha '|&Ī.PEyK&/TwK\_{K⧛V7 >>knLӛ7/{gI5ywQ7Axθgݽz%j_AoPqƫn/;FiW}_q~/ 18&Ԯmt珻Twnn7F]pqA6T2D650_Ր5KsbۦU3$Fy썫C&dV9; *ɨ6:'z+-: S##f7z 2f&5=- K+6!St}v13s8~l- U)8 n(@;8~R#Y\2Y@DLވN PR F93puiT[v[2M<7)[$B :$K9gfX!Aŝrʠ!y˗Q|:թ-]<וXkZp2tw2x8Eu3=F\yDZx504))=2JeN0ߠfZokDm\q, Q24-Y4 Qm=(Y"&E'Έ4Ά+;urw܏8ɔf =ƫnrj*N|[m3\cePJ$f&YS3(iLHVq 'JSČДS gY,)ԃs@ f7; ⸙Zioj489sSe~E@Q:4o/%j[YHzn?^nv)Zq.xt[ܲ!dIiWС8yIݘ2j []lI4\N'?eC+k,~I{[#d{#1z3e=>BCGw-'jV&+[i; PJ2+@$K 4VՀHmXCI)|ko:M^m(Trk"z>17F17Ph^Fb%1 IIeAɔ(J J&OiTFs;i%0^Neajk($zr~r"M5VX͡n;-ҷ_ګlv:[P4 C3ǭ|Ů@(-dB枲ىN̬:1aN}Ѕ U$'bH; gwW$x298n@́zԳ ^54!-EpEAfxOIぢ41Pڴn-,1ŵ"- ˬ +*sP*oLE8REڑ{vxh02?gJasCaXǙs4} (Ӆq)`X-8:i nMrMӝЌ NoÙj :r-ٓӆpO>ʓyc;`w8aM&&T@]II]\SO=Ozst‘mMb*]-RQ Zf#N)I<N{⮖LBSf1Eg󊅇t3_V1JPd!nK>$WM0|5l;[:*)I?eV%S[ 覵Zα8*xqcNiR^ z8~hi|k-)DB_:ytMNg*`_fRA ciM۩)'0?F6`0S^QV#]J >o !+j 곳M*6B7a@e8g^0(?A]_HKصQ8ԪdԦb)s8sʉRv>IP$yS_ ut|%ucF)({5Oup1̪q Da;WZ1SoE$x\9B(E _<1}vS7 @11, dE*~x ǐq0nǕg)ݤ;/X<.ę<ֳ25)$򸛌}CӮ+Y+ԥV 31!&Vz1א^_Ci>n X0q'ǖ^. c\@®}g+r*bw_5m$R:=SFR-\c,, ` M [+b:"(*Iz>R55?.*erlP[ԅ"Ʌ퍨6gBSjqa?(]꬙^eIe+qRؑ-8-yoJ* BG {]X^gnzhd۴zv3pVMfg2{y؀6(ưqd]SI|K񜲷Aj3) +]=R| pTIxe=}8 CĴrH3[S8aƗr,3haPݱ+ز?mzÞۉ1-@ >Wn)!i"DR2᳸0C`hϙoѝq(?D;6fHk>0[}<@J6 ِ̩"wTX}UTňfC*_f}G!Kc:pu+~bLw:[ay+(\xM"JLxzR_D Rq217Q=2%>fz )ӯv=f a-y@OP&tf-LSl֗Y޺~bp!~1ݖn6o7^օ0Z?TFS} aTG)uQU^3 }m۰]6sYr fKZÔ-??W#pYd&Wu}-em`P峏(sΊ-6-m 6,K<[J[ABv#26ٲ{a)y0.\jrZ)g:Kendstream endobj 281 0 obj << /Filter /FlateDecode /Length 5375 >> stream x\Kq>uDvLSVݐ EX۶>p{f-r^L$|TXч"F/_oZ49jn޽7ߛ_V“7^ܿ}H{c7W?Vѝۻnθ|{'e[{g:~,e㝯q{jëJN YI];c͏՛#4]uzm|HVUy[\}oZ[7Jj|P[V塚ՉBUBơOuԞ> z+楮NOYwXH;Q}0sd5Yw_pY9{nҸ0?έ&MkL !x~_ u]{K݂hݵm{]T {~/b?ީ3Uڳ::T֭nU+rza.lj5hoa*] LϷZLtB^V-Qq& HeDtnE!HHcDc$+n\dj%{8.c7oRhٷl*=fyٔ03S}K X:6bUޝ=ʱ݃Mt\ز $G.jR:N  ߙ5;)}Vx9z 0(:9:-HdUne Vx臑FSQ@@yˑs8h\㛗1a]E0X=ʭx@*؄ThQhPO:-'T*+,ըm.5yptFVRkkw`J {DM gmI)J1w jCׂHqp(=-:#4lMpдD/:!A  6N?Sqg:jB?pb5HMZs ɪ1E6@B[ϱb!+d%__͉ Yϛ!56!TayFૐ*ÿcAU?#ZI.{\}D rI%xQҍր UOl Jʺ WNJпd8ƛRФ4/)i7{Q QD!2 ?,W2 |7YB$v|%.E&;0|26$|v6]v([D5f޵@'5M-<+ }󃅼ܤ 5uCUl{O@npYOez,O|)ФlBaSdTN4NC2G$wң#"($9'ޜh7H0" "UFЄd +2A905&1,l 4XL%fӏBh:!U7v BlX/^vX0pDsl I+`bJ: Pp@.3h +% @ fQ:HoN(hюaӔaWmC$IBy1EBP( ۢcJK3ݹ_c~e.Xݏw1qK6=9q$y LGuz.so ɑtBJ6:*$CBE%ADn HE%VC2?,G"ÍI.%17#Bo6*V@Fi+f[v)qbrY R^,4ͮ@H\q'&˦ @Y*ԭHx4*)09QQҐ)i#V 8f%`hpREJ/C,MۈX߄[r)qᤢuU؅Ó9Ɩθ s`ctB;~83($Fat<[#`ztS4,D-[oܛ$} M+(EX›jӫԥfZ|<̣&=} -4g;P@Bf n Z 7NcPu-O`NM_5{"!FnOQlKLF&ig\@qė 0j"PȻ#}hNIW l VXQSdTqϱ!Oy$Gbn>gX. `v`LCw=QwrT)t.v b+)l+4Fm=xh 5u(\l)PZi 6Ƥd X<{}IQˌai8 MSR6؁+<>D4|nT~\Uk#[CqtXDP|KkۇNTݸ<,ٸ[PkX89invеm'Q n4MN=ަ|-tl.H\g! Lt|!&]l"و666~5f)dh3"WR%T,:c4u'J")m% s2c#&D!<+I[] {6ZPp(&1⧓02סW2iU@5$6Sԑkm->Ԓ's`-SAK!Pk]OfS?c/87v]VI҆2-Dگݬ"];Ȅ !΂00}hd_bC>Bt`!S?$6f^SдOn"%Ѕ_>wc3.2A j >t|1Bm|kf*P=)\H^ݎ|Z[6-͇# Pr@!X-C\3z`||F*ȮH!9}B@Knɳyn%T-B=m,߭&I3yʂgd7]m|~'Unb;o鮸XYbļŬحBvdzc6Ru0iwP*b]A꾝2ڵp s Siȳ.K%9ؓj3R?V1 };X5}}2_8P4 s;1o|.drz$aZ8׹u>uA( Ňr3)n'*0{iӥI._E'F Wz+T:J NZE>nd=i8l16Ҩ]O]$Jkect9o-fb99uϣ4sj:4k+".]T Ϛ5U,v|&P6aN~L#mZ5,)Υ60C8>hZ-~Gi+bŁϔ Wͩл,aijуv V2#2֏)Wθ%~4erfr,9ӋrT?w5 hs)+r(5u^sjJɭp$ˈVҡQ,Y×rX#Ɩ1Aqpk44T)y7bofAzvL!tWV;4]YI/+7(wcf9N~E=_&Ѱx I(lґ8:> fkb5O? HO 3 g4dt/M5} 5Pbӭ+/;b^U/k O0RBk!<8jAMMH ?S1/m*}!剭Z $j2QKf'#Ô|~aNQ:g|2Mc i3C}F?3oE@gBz텆0y(4d!婅N~?ʅb3NlMM "miVs6.r0xL.X[`âͻh3+n_m(w`gjJ\nc6 nZzDҏn]6OJ*N(:S;"TS 9>ɭ<2ն@endstream endobj 282 0 obj << /Filter /FlateDecode /Length 5417 >> stream x\IFo F@wDӶn:|p.JIQ&%ȗA$%USUwfp땢_Wꫛ/^: ]өͫ+VZθ7nP]vgjm(1~Yo81m|<^_[kqH>ޮa >u׺=޸Vi؋[|k7!{-n͉#U/ bF˭[!m)Xoxjp6DUo~w\Zŷu! x:χDvTZZӭI8uW3O񍶫~^_8yUtMj?w杫kGF|8V>g 1ksABw+Jp cw\]*!IoDw/VB07qg aw~uLlp"@HP 6*?قVjazg`K[85md~iAjI k:1_8?h"Zʷiᛗziic|! Sܲv ٖ ^ ,M?P9fJTT㞕 He6<[,#Me.cZV1.ysl`bKӈVCG6aYp3l,իlt6)GDdݲ*ĤCݑǓ.Ō 'fp: +\PJV:y BFWަ-$نC_4xݗ6:>͡ 5&i"N_Ȍyh@u'3: R@<*}K:~ 3y2EΩc?qPY4s-݊"WOFA*NV.ݘ |ž nNzP0W|^6z3z]6Ֆ-{*Bd,yBDGGP5Rޱ 1 y 3%{ 3lB"|:N%4Q6 zr S'O@hp in F#<=~n IZ;@(fp 3С 3Gec*ď, ?'ڱ_͢C%ј3K6oy qU]\N ⤴%Xi{3T $  jh{9G6 da)J'B K;! /i۠H(D j@M\`00!mRJ+=A C?>*aQs$`nER5Q@Wh!z54hs+oxB.4jV:+qjsuÿW҂v~<tN*UD; i5h[A}1.@RMӃD=ә'U `؛.4wB$;S! šO(5v?sw9@ S&bgs!5.ZF2良(/䩣g!%LGY#xdoS>幖||s З)T'"* ϓ.HVTn$:Rz%h;JD& gb\s >lxPgcBUP\0 "F́OpZ\#Mf@PK))yq ]2(FaROy >|i3C?;s(]vHkg|FHd]Dݞ`G>QlHLaL3 GcL`@ۀNDg``[_c\,'&qP;As"b҉*DK A|~!tfRJc*@63$ A ~LIq aaw>,l8'VzlOl <&B̆' ǣ'>% xYlB-^Sa2Tv:W_` &{=R IeV2f[cV! ʠ鄣(H+s+0zwl79`[O,z"Hؘ\"R^skCa`6fב `I?}u͔+?}@{>H,YűS~ɖ/kœ|GIIˆ3'Sb|`|o=NC4TPh*| MJV. "i = #DEi!̐Q-SpMjhN YoPt:3?9 ۼJ,}ZӍnpQ^xtd]W\wJRz FT5x@AkP9_~㴟A d]S~WҺ#1NFg3JYΘ}SN G>Xi6@p]Z==vKFMAWҹ[9 8wDF 8P?$Ug({ LH/iKӞ6y?"Xw:_E@$=b5vpKOq+9tB}/7s2q(?3 s9T ٸr61r~NfL 1uI\z~[:!YE1l$Kɸ-,Rj1f\[Syڏ2sȶZc;[Ď/5: қDnJCѱ$m:|@S"Q%γ8u aϛLS u8K;?ȱuCڢ0 IGs")+遹bOANPq ћ# s:S(J2ц$x|٥d9% N`}T\;1Q~JyhHLBϳLƜ1%mH.^Jp0Wn.|@];Z0BX|~OY\7cMaBS|@#f/6]^{;d^ț<2:'x)v 33N}7 1` 1D ئzB}ZHT2 yj; E[lOS~SM3J>mȊ`R~{vLƻ+wfIU>1؇)=l2ת# ϽNq%eXZsK!ݰp>k:;ac|٢|W MREE%:?VT韄0@:!h!W>/ d"hOhtmT[[!3 3+')Ezb`eAy%.PE^³APFZk6)`EzZ5 ndp6٦OB /'I/ SHY$n,zEmS )!֜Q pڄm}Y f`T:>&Ϭ9=9aƢgcUIL L8şYzK)r =_.I'}ÛcZij5D*KޮљUiOMC$D6qNh a[oM.AHymM<{ϲxt~R`iT0D\]fUS{5/O΂Pr& V_dXpqGVWމόg,2mK3[U u:e)g ObD$ϡ<'>&.uU" [Ѕ},[ !GeW~p Ttcc ~{"VLc)pBP>ڍ)[t̙KŶm~ҏy'.7 io֭LI _xaJYK1m|{"zb3c@v`%,[ D.ꟽPsgDh.ZE^Jn-`#X]BU\qd ӐLFCuv(,y?fʿˎnd1"t>; F~l[{@O/=A 4+U݁ ߴrk5w= j"9>,'."(G<3qo -0|7XTx Oѳk6[1LjC J֕ivq:ZLDfô BtXi W6ebQxr(R'#¤(ڲ.T+ N:6 sC0?fooQS;0Ya~x_\ЧG%RAQtQ>T%Ò7F_F*X:s wvE͑nAo?G=Z 7q%3+HY&WtEdel߷WBڇJ;e/۫.ϭcgjko_M-8]a|;ڏZ9P5Xb=*%]RK'បlFS0yg>T X172|fHCWbk"T˻yendstream endobj 283 0 obj << /Filter /FlateDecode /Length 3626 >> stream xZYs~oÖl``f*rb<@䊄KPtקgKJ p1GO_݃W"oՅ_7Ί拫?h‰Ջ ?EldJ)MT:^<˾ayQZa+u۝R2wdWyxvUkTˆ[ةNvu{/0DtNk٩2Ue[\[\.{KO{9.Ven!@f.Z7=2'݂~g+# ᕑm{=zj +N&%>2ppp8̧r~SNfvwLu=4m>u6sTi&+.a*xw(1Y*YUduw+9 Fgռ XFW*K!,GxFgNF-{95oq <]tPURB讜ΝehTp//${'?DSP?D-5O.$Vߤ .FX]mBP!4INm+v(b(xU:ꀓdC..jp`Fk@9pZf,qKq 'L[ؖ p7[ @1xET233?b01gA*uE1ea?EB 8í{WP@\9i?\0bl.!ARJ͘VعO<$PQī`CCd6wa';co<+2V%x)ӆ:W"bݳ fX9;?*fO-GƬ}7,'P3JO9mHU%,eGfNA<;(0VPTM=8@e8Vz@TJ=LM}8{USd0naCiQ'>J4ސ2.@S71屠 mpafk~_k}$r>A~zTzPb /L΄Ce3$ދbX޿APk8 Ơ. a (2pF'}1Lk- a\UqgZRkNbþUQK2x(<+;JӃ9[3‘jmw Z πvݎx^E,cMtZصHcNDPfzV| G$AbٜVh %- zʯySB˚)ب8,t1oD]r; :WhcJ'tXSŐ׆!rېLmg܅ub ೓(ĊTH:+Ѕ@Pe5˿ $. ifwVmK0l+!#uM;'C*{s[gPXEI8Y@3q#Úyg_ Į (Z0r Qb inAhڇ[FiyЃ߿ő~ [[کUdƨ@ƶhۂn@_k()MG9umaOf^iHC@$JB$T5 ?rhsǠ)y~җ"BJ\[eg{ݯ9E<2TG+Nbi !LZBI ~r7#]i)-f&c4p"W|?O!0ص[ .=ԓh|ら+t 2lA>۩5 1yP|YƮ>J^U5Ag=k'Ռ ~n $|%8X}Ir0aڗm+ H*OvJfo I#MiU{ƿ4Kncb/:1;O"|{Q1h'Yjl>7ԇTa"v|,>20̭OׇEs6J螺U)4u%ȍ;\K6C<́֔,NʹQ`cF٥kR)6)]HEKj;TE*@1G(O+}')dZuqKӬM۰C[UI'ΓH 1ӆxv"_/퍅2z-kR҆;P;SkXvC3D Rףc##5}_DA= vio^ܺ>Ԧ_KJtSqop*L5~+ VԳŭ4T,]+3k*l-T@b9nZaYd+XX*<eV`ی| PC|p]zz؇ϮҊE=;P~7vuՏzcw?}vxhps|}@XZ}<"cC;`8vE.=]2DկOڇUOph̵7<y:C}&+$'4 .| |Nⅿ8j. o"endstream endobj 284 0 obj << /Filter /FlateDecode /Length 2279 >> stream xXK6Wj/P*o`Iٮ$)ofGЦ1xEqƉSsģ믿n::ǿZՇuO~[Ó斮w+z,i*Y. 5ʐfeh*'Y[cI׵v?IR'1i28;ݻ/+Z+y.YvC97 ]kƲ\Yf+в_g[V๗_t2pf2)#e|]o72'wfܛJү>1H /D9͌s>Js&Ϳir@ foI2i5ʻiXEs؆rF&DIx w64g4HIVKrl&fgЫ={BgRoH}S76TkQjalI(rS?%%gsZp3leyfވ2av-;T \M:皓SafJhnh=ϰm*Ȼ4$) s&>K>V mY3k[RtEM}3uj\r,wo)!:>>)PͲ& `@5 *0fp~()\ݷh>:W$x'D?=rSeRzl֕<7^OXs )c}<'xbp % ܏0QM|raP.iơ`z H0yf'o/ʆkK܍V gսݠGPc)vpl7(բ=4ߏFS0\@ EZ{ WBWvm.񰴞Q3[q:r.cT} {BD=,1u,k(ӡ,f7"FFvfumg9tI|8\i l;Cp%6qZ7MYtnQNA wzhn-N3q !]]bz*dT <|b[ B;xl;'r{ Wʑ~sIX3Tޗr ׷(Lk 'Pu)(PژvEW7kWMK(='QF;ч4DYƗ!:2VlxtL{T?DgNP},)acjR 3UrF *(4pO!p EXè;q ua#>!"iqё>GW [e($ƽ⪇8UuelkUm/<7 zXՓ4亂Sҭs ¨b(cE<*`ӯة]c/'@ub/EsU2,n;VUqL870ui}# Rx r\Pho)N083r7拓h-vlʰB? B> stream xYM_)]|bJbRT*r]`ג(aIp747tpAӅs[y}k)I9]o/t,ɹ\wg4yS֛+_I*yFӜ$LrIhvNJsor%)oEhVrŹEr4J&XP&% &k2ڢL*ym !B4ɥd8dKDXqhx"J`Ĩr"a VuV'mu*X Ru;$5 Դ5#0Pfz 1؊12fln(԰?,bLjx/#XDl_|rzv' cXSA͖*\}Z0:yg͵"˩/)Ų}'h\R]{SGz, 1`RgGa H AUch=oL4e9I5s1!ٽRbt~xyON Đy fC&ɀMaeYDM9ɨC/0AǾ-nqF$`BQUHu6_=:K9JLQ7m 3Ƴ \ "o .xL1OU>^/qִ"XOYAK4Wϕ:v2P$n0 Kr_&vJp>h5M# bϐow!6ʒ0~z8qq}Rf{IeQ !)dgTW[Ј "\gTYiT"(" ?wnsTϳ 1H`*,Ȃ2@MD*Ɇ&T͵<bJ$^6}7Uj'*&=l\"9 h^^k_#@+=-:h%t3c'b3Yxe.2>03@`YP]ĘPX1A Ch0ル/fAlTd&kts@g*)pqҝҭF<2Âo!! TS7\'?x}g'lČz]P@1|! "|&*f8Hb>sZ! bgl2:] _lT`Ո MNPS(TmE|&r!w>s0^_Ghʩ~hPň=Nu 6uifFj}+Il=Ҁ|8Qy9u])e$95i?-r:!|\Nh& x2ZM-)<ϸH5j :]d4& pTF㿚HL?iL5װEca4F^HسSɎi`׆m H&u\BC)ٶŃa!at/J)KC*AP"z+ohNYhPx/J3&<>Ft.>Plё48JO4.i?ܛ Fª6!̍1+-Ψ)Vde I> stream xZKo{OE8aFA$fu @IcLR>UdwcF !Q]UUUju{ەz_) oJ[Y:s⦰UVF :ߟ%(E%`EqJ *[l5ˊqU|Jн[>#uD]*]ٰ΋FJS7m]oIjպ.v;*`IU & zTrDUNӂ *qFp^JUZ3R덪`][S9V1a@Idi.aګaۓt NZ)~<9EV6~T/Ê&a-@h.X14[?Zfd\9AEށb^ʺ. k:A& FzZf7@ߟP鵄b]=wh57 "W u`Ѱ.YO9s SKX]mrJmIEU>5Y΋F-@5حX0U#tkgBá )Q콬V & 7Ze3}6FmE1Ck#0Y{hɪCl)5w>Uz*Sh^q0AAX郾UucaIIG~}]sZŕO\SH @!<ō`߷~0)'1lq)ftޅ5NqSe%8W$XPrX'񅃏$~ڦ`*g;0b NZMfNɂpƥ(H`}~7iP 6==z!A!+ašC4< āJY;I3Q>M@, HPaEm11 &ρ)=KRd\;cOܮHoi$qerOO@T顅1<Zshr!%QmmB엨b.e͂m㪦Z`~Їv{\1OW &L`CDk%;ƾvWj6Rk4vޟ"Q ԍr_4g4EΘ`H,+,7&(>!xGn@X-l]'LwK.o9½A@,DB}2Gga8Ȕ%<'9+ЈTY2d<CMT1d,>X #<{s5M 1J8OT<4"&% YFkA^fI9M&QU()HTɊiv Ɯ3P97*eoZz=Eōiv ^'xJ("Byഞ{t6% ?,FT#Z=" }(6-eζ8Pkjn1U8> "XEpSȆxۮO5{,K(ibgY. 0~L]Y;tH4퀳~Qg]@u8P) Bmк(8͕cX-vX:yY|%tͮ=T ~=ZJ>ͅ),֋:6 09>/ccu5A#W$8T ]PT@f1s2I4@{"^(, <ɾ}Ch[QƪFq"#Jx/hZfgpr*:Oikɣeu? 9KI=λeFgW˥C% -?C9כ Bз1 @lp#_5,IT q@+#& ԡ]8 }Ӭ3`4c[j^TEͧ#KZ#m(YIp{IԿ1;j|iGqa1>z.J53/*K:=P3M~ ˬ|*Ltkbyx@>j~[Y*rnysX^Gهk 7Q&6:=ruE/2PBoJY*kS] *s׊|e$wn[jn3'o#Gɮ ^'A$4rū1m$=u,Ua0K#ahAҭkkLWяE-yfK8)igs-uRӵNVN%F"w~q󭛃mĩMzJD lzFg9/PClw E/|T@e,"b1삒2t;HnqH t&;䭴idgy=QNjzӣNUJU Rz/endstream endobj 287 0 obj << /Filter /FlateDecode /Length 3733 >> stream x[Yo6~oÃꅭdw.,59IHgZEZQTY:7я_ʔY³`)uɬ})m^d6'!0SUamF<}dz=ԕr~{>\#sUYU.{P n;HySSZ!S1]'5>0$2,˄y6#!s˿CV*z`xڥ(}\x E21Q;o+,,f9||o }fJ 5\Y>qg4p h}$JB)mN 2V JEnKuzǫYv5L'5`?f[ j-ΒMKdzVg)F\_3ʦ-F]h1;ڎ#6i<"UN#ҍ+A&j=^mж*M~߇Mׇ@N,26:G?T.V=\/lҾTec=Q%:=wS|hˁc<3-TBRy%a}KEMT._GM| wJͅ[]W6 Z|g( Eħw_D|l`'B:Ø64շ^Eu΅0\W|:?{ӶgW^g׉g9 PK8Mȴirpg7MDvgɝ?>l;x+M o}8oCl_x]<g@! Ӻn(񗍅d[ӣkDZ/]Y kؖM$_UV́L9`$ZW ζͺyXy9Ybg]|X]BjtSvrǭ 3ٰ{y58qqbhQ)Qf.\;F)=F(X#xJTdwyAHHM T<%.0AGO`5YJIwA†83VE?E4#OZAG"BQ4 `<{Q QN@JKvDbQtXў_%2M8Haw;ҥj e~8ݎ/>On36(@x^P7SmHFq}z ݿDdmR2nJM,^B%*{N +&CՉl=X' Bұ a!1x 09~N3<֤xc@!\_4Mbͅ8_l>DFK3.$Fogъ3ғ]DdLLL2p7qïv5 0a2d)V"p3G!)FSrg`4pf,ik_킂$e6zM3'P5, 桜6]*Hq1|*yHJV!?\)} T"tNVZj.KU!pIJWͮ&| fˉ.SvRMTW7TI.woșA+ٵT#s\%,4F-O)SѓVIRdAP] %Z]dAq\Tw'2/k#mRӪ5z6FIs1CXN]#7#$~h;&?5w[DZj )~bB*~|mrv$8D%OnR?f'u)S17 aeA#5PB G%Y,MH."Ǔ*\$q si=q TG _rL-j45ּp78li|F&J[~/|魸΍ Rd%2ڎRrbiF;ܜk](v˩ v%Z!QQ酢02/DQ<3@p  RØ\n.RO6R„=Hu)B,UQqSC+JAt/*,Zu"ʒn'1V:Cx/xaSdukQxq4Am'NYEBC,])-t u_rHrU.a$&Yβ^ M>cV*n(S?vY#O~aIPe…*rq!])1Ea4b _Rg Nit_^<~;!ɠTLM$dZ(gǹM= `ZL\+x$W1*k7|o [`sB$rt[n]!]LXaJqaNAbcŃRl^z%dz$"#u8+ǥ Gj塯?G'wѸջzPSf7k+*j׾L:)7:%۳#yXR'6/E<2jZ'UrBS\VX51h!N> stream xZK);`,>%I?/&]^y׭yTI]%Q,V}U^,_ۋ_/8n___|B+xS7 eJ}y`BOKYRBKv*Rˊ W)5;߭~#qd]hS0VkvanAm?nWk)N^5~ymjkN!æ'EuY8 w?]rkk~@㲞XҳEi,%j&>ў]{nR^8=iB++.k{۞xj+v۞_>^Vk`q%&jpkQ2B]TX훴XMZڑeY*{9-2z֖qb)ǟji6YQm1kp6"ԕ`V}3]]5W㇛a?Wִ(ړ7}'G笿+n#d~Q= qu>m{.aC_mG}6,dizUՀ}mXa] g-<[kٷ}lNOD'!k+{Ey9*E"; k¹>R^d[}1A=U LaH#j(9z@ǝ]gGաF!u.qrȸr:ZVUaf#DT"ZIG:W5DC[2#wN<Aa xsV%EqKR$G,6X=)h BP` pӣ})ŭ4 @E8:IG 5Rʚv;c&lMlV}XR;kTi,Zz"> l~ƒj0DG/g^ G$8 0]"b])#0$"Num%ry6~H@F4zzTKa-hNҢV$$p3̞C1x881 &J90V2Z,x ob!M@Z-)mLI Z CHV/M{Pli@W MtC֙Ev=~:MJ''x4\x7QڋTZڝ[Zfi71,Ud=1;Z6$&JfJ} }!fѴRVDF2Y޻̀ ;ugEGgM 6[b,# a85#3|Z$FgLب]l;xܒ5u~X}4 Fg1+xi$yMi,?mMi1O!KlA b(Ͻ dWTSO N} i\HbNtjVTq)1W?vu_r,*?&.B-M\,γfa6p3VnXpl#)pwV~ u=Mw\W5]*ֱ(m^H U]lFɝeI>oidQ\>o#\͝/e@X !S"-Pՙ"QaӞ+إx 52RJ.qTYKeT.;Dsapf`Vx6m 8@6#W\Eu֗,>Ě7"ִH`_ L;FEj+C) RY +Z4"U Is}Q☉0EҌ!29@,Aezϼio};D(+$H<]{{UҚJ 5a-qE„n H hC7W!pɮ_i5Xr4Lw8qE7 r⚋qh٥"!oă&7}zi̋;{9G3&k^2ICI>M[wqCQE$[7( =)QsuwĴ_d464>qk`ʔ|m!j7>6׵H1BIg3i)/4b.543~<5IKR~2\k?txΧԓ\R2CiPjgOjs~hgx s)yOT +s{G'D@?c5|>q:*x@U٫&BiL,&ŴaqD@=!q'yT'yW8B?*+x+A eYZC  yO lcPmAzX'o`"u{B'6I>Rı TȊm3.zumYU=%*$[+[w9wtKeb>ϸOEqx*7"ac (]~Shyh0ƭ.# #d8ui;P2t+0bfW𜎪uHyij"a<3mb59epBUbK{Vspԟ&[qN~^> stream x}V PgaFt =FQeCQ2ʭ"88AP΄C"ƈטrfI܊H\5r{6R]3U{)(GJPEdMH-`JPkB UF؟^ W\Jpv<3ftW\:R*˒fddjL2E6@ IH2dҴ zm6<#O~MLNMXZZ .X8r/{(9A9MO,H'f,G-@-&PTMRArj.GST7* (ʑʥ>U)B(Õ7p"|'L D Jqy =*n 3l+ F M%]g]4*O6܅^XriH>4\8 =ujGڃk8|&/b$Dc.V^ T[PmRMfPqGGIӳ#rq։ A<㔃F H|̸AfCuH &N8뫁 /4o IaB čI(ǥAh|GDB1 Y* o[i@7AR}Ѡgd|5IM !/@3\Pqj{[z?FA n;xY&k ,2w1ԛ͵=+|6yv>"2p>|O)آ1KO?G񨎞5ޗ=Gs=8HA ;o_ʼ i'^c]67Q 5D. NZˣᮑYN6YN3p.s0|Z[y`՝WqU._Z YSѷ*߬Y]D3=j'o.46{v6 7z] |VMjek?7ݩlϊ`18yg]̗֖&`s+[Tþ35NAlC 2ՊD<#u"i/q] .5*LHgĉ&6E&i_1)n?8.Z$&ALD CZ/cz,O~@umkE\t-ztҩC"(PM,>&"髬-m ǎיw*~fM-1Lj+WYx2,s@ `5H,2cԢ${HSCC<FR.cR˽KdiEF-TUon4e$dT"MF||J<φX :#,LAJ]}TqWr<MrđvGf>7oɫArxc^Q/ u׳%NFItOO-6@0lbb=,,yhc[/w9R=p4(%n~/ {Ż1a^Zp~cT8X sU b屚ʽ]{-#(Eendstream endobj 290 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 929 >> stream x]RlSU?^V[֦4flYVLj KP ΕAe,qhe:JtR7{,~Yu!KHd +)hEfkoX䟛{ιsC!QUPgpncez[I>%HB"ٶ(eX%Y-p")E5r՜7suųumF־]*[k_L:m},mpfm[mlq1BH|~zP#ڍ^@uH)vdd䘴fK$G!7ڻihH}I}r?fCreget~L q"@Ǧqrip%ʜ>Ϗ[rءx_ Tx :PPq *JH*[^uL퐾̲rۋ\Y4ˇ؍Bf'l-).8',inx_sP&tlFdg'=ď‘Ofa:f6=x'ԉU~--XkSTFt7wM7+W SxJ*KI 4ZȓsFs&&bUΞ\ŹI߸ R>,iψP=[baK3yNãH8'*xÑ#êG.$endstream endobj 291 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 389 >> stream xcd`ab`dd M̳ JM/I, f!CGO]VY~'YX|<<,+={3#cxzs~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+k꡻g```4b`f`bdd?C]#t/^ /Q]49پw|gm]3{#u?έ~㷠poM-3Q^8kdw܊+x\7o^BX'7twIg+[y-ý&L|gy߬e}'N06endstream endobj 292 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1067 >> stream x]Q{PTu˲7Xl>4iXA fy-˲+C%Ll(E!uHTiH#Gދ }[0W^} $=I1gL0[,󾳩࿄6D |! wf"7C}?Ŏ*ɤSn+E]0 wO.P udb#Ar~ #tDe1p-!څLS㎯oMo8qs"N|;^E(c@Gv|q}sv6p¤CEN!g(ćNzzZ뺌pB/ŷ^h[ܺ wqMkz/F?t9<5olLtΕJ,.2UceP_Kpa,y87Q- jG;CS}luaZ0[#ZC5 _)@m^Ieeq)y,P}aHR\ `4"?C]?( `IL@{%$ RV'Sܳ|yYF/YK8!Ec.DQz*"E 僥À#_ugνOEBĚU5K@_@qEk5~X[C֛n.gw!RZu2R xgH-NL荕&mAFI="h9-ЉZ~Z|⾊4+GWdfa R$۷Րhe͡3 4w |Ë=s$GWI"I? # ^hURmZN @Ƣ eU;䵲H}Uٓvj3 TmNMMUuXl1MꚚmendstream endobj 293 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2868 >> stream xW PSwOKiզKt]UVQXC 9HHWH "VEmm{l٭3)5.#Y LD$D߲o`ݑ{X |0%"~-'7Oa=Rl? "( 6a-j5l{{ Ǟfa6N+?zzܻsrƕs_[=oͼ,A<`KBr蠡K;h1ϡP^]v/^]ͮ#)Gȅl$6?x.Y++m7@VI~Y^e{IY6WZw=W@t7CJ\ ~9n Za&iLo f L0yY`#o`-FKxGo>(N<.@=kDv |>2;L е&ęxxN%:^-*"cVs Fs%6j{^( j r\a"DbLY̟\GH+Y:(6h>U զ+A+`)SG[dRC1y[|/Z=)d*UlKNzUBY!fXZ,+nyBV0&)@2[%TP= -pEeE %ꪚƊźxS/6:wiۈ2}& s״ $.MHJ]ўV@.yK< 4KA^N,6! D0ÒڄX/̻菾 Wh;XmUfu;U +nF)QZ/VFOdr#&G+ƸΣY d!WCH zf.4W@UXBKSc?oi7F} 914))Sl2.mX-K)>xؕs•,i.6U4/  f]u=%c9ǫE`V*'2%C!$ %~P}X1DqWXf:)`ĥP/EU ~NTƱ0HW7f v_4mxxFiOCj1RRWK0Ϥp9Jf3i?ED٘d^(-h^u70?xۚRR' \HyEGɼ_ d둈Cljjj-H_!{ވI$oeС!F+\RW.aN~+6~}`3C(^7^:ⱃU r|s_Ngg}CU |X;|1"Y'C.!,c6;XHu :-3< !hFxW9IT=f̘γ,92OXV 0+MNN=3g;L=ZBhnp(#%Yʫm^1vYꬵ:"{8X(e/#3nœUw-o+D9Fw-]y = )]頂Z)7e2Z(2=aendstream endobj 294 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1039 >> stream x]QmLSg:X[ Sn6 s| JiXKERՌL$ i̖dcF26uYdC{klrs<8p?U֥+ :e`"3[9L4Lh,<#=:x0rA4gD4z!~TQWoO}'UDe$P9 ѨP:p 7@ +*J_ETQ|7?Մ1 HJ~$$&LE` |J79b 4s7ȵet xeU dXP6̏8C7Kp3PKpJ{ai[߸I-wA lmz21z?v_o$byw-tGS?pSJO/\7޵烌}2Z,663{|5M."yk&ןxŏ֍H0BH{6{]<+d wy[ϻF} 'yCboLID^k'$+f[-b3| 9,'H!{DF;?v(1a1W#IPG ft8-s&`&W0 =Mm$Bu*>Jr$+i c|463?EҿH)L/"~VsdВhN@Z[W`,tY;l`5ꖢx J,N D e8u9{{ȋ% P8iUr q {7 QӈMğE#W$"YzdW^YKXs(3r*„՟;[)@&5˾[Sv0|nWf`}8)q/_emla DЗg".:5 cte@&lL%fbvE!>J . ?u\vڝ=vg_Lendstream endobj 295 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5894 >> stream xX\S!{E 5PaUT*. فBI~);IOjնjEmzx?[Fc<{w.fFxQk׹H<vxg373/Ez-v/K>X;9E+GLkm$J!a~]0{63~{'@itxG{9دF/I=<$>R[7tqwtٰu>SpY4dEʰU=b~EM6PԻdʅBRS&j35BmS(j6ZA͡VR(GjZ@9QP :j=eEYS(j4MR"j,ES O , *AF%yf< φm7af).Hї| |Xg/|b%f~QFKx6m~3ac2mgf؝9n:`Oa0E1@}(PHKǁD~KnB3 s@ PLufP$MR!.B9 ݡ9`bY[V+` ?0٠aבu[Vf<2@B( HçP'm{n9jQ~%`d]]2XMRQ(TP0z :ȉfs g op%gxuw|c "ۉckNǣ!k>yBwvKwmࡋ8ڦ>;Sb0 <4q7@t_\+~FR%+il !12 M@Ӑx WnqtZK K v*ƃt:{& n=nL3I)rx8Iox]F glƛCG1vfb[>+>.+`e]"`c!Bސ0w,[92GOo|F1yv?kk@ 6ȾQo9y$=m#)CTBe $ zT*,LLIXIT@"^OXvo+7Hl]}-ln)lw.S~/`O Urry~͠[T$BLHE\UEUq=GZvt.8)"J&~Gw?Cs4axMrH( {)h6WU~ૃ(* CC(lй`CtHC5c((@]Y7{YQhBa *05JB` L HLtI$ߤ ˷VE%-ǒ%WbY0Ms2))b<,fffyvu0.iMg hmץM%H7$G x2Z+&͐3a4=\'nGXM emF6ޠT19[g\ޕmk^Ko?ɡφ ӯ.505Do{w!~CQpPl nq:SFo}MWU>ͼ(8p1H QIDB($)8SFȂlPhwEr7A0 .b>h Fy.B:{?n*54L>pڵ{`W/&ʢ$EnB:4_gsz5,nƴҍ 9Z}(̢k$q5e5n 9[̱zbi;~[ae i)}.ȬmP|KKvޥY` Iuټ ".J% _chl>",!Px@XQBЎOyS7 5)0T{+Bn&ΰǴP+:B <|EPH,hP6)L#yfEťՆz])HP@ȒMIM]j'=&$Y|xϮ"s5 tΡ70n>g$d*!L) n]޼T&#MT4vvqW;CɎ2~9`) v!#[j p |.x.Xn*Y'>](3ؔIc|\ ?3S)8Y4"v5Paja\.(S(9rs؅A\\ͰOrTƱ51%a!nm>j6_SzQmGty{:=8G|h@r(ҸU[Y8qT52A0Z]SSp~edUqmc"% b^D7*~S#/plJRB?S:;&<.RuTY!gUbG4V3hNoNYmu Fs0n~k۲f}V9[1&_1ȜfG?h y#LIZ--ឧ0 O io&bO!o4tcui dP"zFO=O Ir0<;7|cZ­ZZkSw:Fi4Fi[v4e0N3x|=Erp|sko^B!#t/eDz^>;ǮF?q5O5."r)ଘZRB]a/vf1H|`@<%bYvLUQI^0%86_W֪WkŒ13B%n9I6}YשKw Zhz7UOWv?+Dl/%ߌWpX=ӡc)=xK/̂} J%0Yy+i)/c~ӗo T_\"Ҽ_tYנ[Q{a9]>g!ϊUqqpx<'un6WE,pl$gEDt(@锑yHlldbnц(t+TG0[ΰ"WꠠjԍW"RrѣX2z?\D/ڲ1BOԑzSnN *Do^#?C3qUz@tMt9$*\Bl^a- N~kGfcwi:!8@s`݋SJ 9Z&&:R Ul4)n&umug8GPDo6 ɄZ#" [Gd4CDDNH5l *'@q&F[SB)cҮq )L&UGv'6}}#ӇFD ǘ!2Ҭ5/7j'œ_aےȜDg$OPS=ob|&晓GjFEcO[&3z$L7ۖnb_ֺ:ʫ`8!ݜx"xo(ꕉQwT鞕FۥVf?RFk Cٰ#'H"$[*rAYP"1ќWjڱXg&FF֙1rMW.S*Ko"^r-Ԛk?ݵ=Pȣ_/3rȠU2fВ~MV: 3+m6wΘS( Q<#/=~1!!!e!M2,~ہHt&=+5; dABQ-ǵ!7Q|.\G",gXb()wYeFamL_BBF % Y d2i٩I.Ŗkj<ښjkA+$ j6\|1dܟ#'4Søuk^&!H98Y>9\|zMtY&y 5z|{^gӎxވx[ʌh>Qӑƫg'N|ʘ:}j /jΕqdΠab"XN(2.Y.hG߭132u 1*ĠQzGm9/y<]a67S*Aw';}yw,9srsgO&@= GNl7+Z}16A_'mۙQ˰#GDŽFebVe\G_,/8v)>B"\21> E;5d t%t(?}l@nXyv1T[Oo5Fq"CBFHlBy#`oڪӅY7n vLċNn]pMD̉krtZS5?Lw! 1DAGs _/%x|"D})פec!؃z^BcZVy13|lh9 cٙ_%CZ!|̶ 3a"0IyZ*~ 2wxBA S z!IY2)F}Q=zꥫu0jxLr҄B}dXBfhjI q{2$UUV{6v1[nƽ_eZHwe%xqd-_O3Ʉ57;FJt^]i h{J_ͤ ̤ؒG;;8S!VqoGR,&Ó%iHd q2#,n_ Ā#+Qp~V`;qn`9Z&mJ^h5,(s5endstream endobj 296 0 obj << /Filter /FlateDecode /Length 5821 >> stream x\K7_X/Y UN`6fxz1RݭvU]rUIroDb0UݲAYL>"_<_V\w/~:wO? oZyq}*|"{qk27۫_ m`mk{?UvF9} i)?N~^I_C0>r~|XM=L/z78؇lK|7͘5S3lkmgԚt7Y+/sV͉{O>CیZRDUVka6wD+lWH)yKo 6lc|,[a"wg`F^1ܕˮKo6i;e3蓵>utm(S&`o3עz-Tk?ZNhaNμqΧ.£ fVAjtOy3u}Ǿ XbcwLms'HL m'~Ϛ[\l7qGZdb;OrvD' Kq ߒ |HKF7?\?_sݐz x;J@ۜ~DU; Cƒ`#n3$J~vߞIh'}d©fիh4b߽38ӘNFy?~Dtn}6̔<0eƭ(j04CA+NXJ+& _bWJ71t޽=5*vr6Y5H҉8Y(L(']!osag8SfƇ|IنO>֊q<%qpܿ_tGԷW)l 0PI[#&mݽτP>+Z3z:[Tj~t]>h=8lkNFM@.H5?7iIy:=́O`hh5Sefl2p;MT@`'KMy~^rqPp2 "IDTB {RvhJMЎv%9\Vw\?96QBBUQZ5]U4 8A\'* [ts7FNZ#q= QL ȗB$;zQ i1Njw2>N`k]'Jz-HB6 Q. `̶ Wp;[paV1s!z6>>( G1ïn<Wk]a'UcJV }#7u.c)ʨ_m:%6C5$[e&FQ#9IAAf?:PUP*  0&ucYTFT̜#8KS]PakWGB5b:4a#ﶫ%hc'h5yD}jrŠ֋ipb<M2x\ bޛ°XL aw-Z舮V@ @]j Dh[hc*Kؼ]E?%Ʌ! {M]: Ԡ` e&(I41ͷMy!H@IW?<0(XY|}-` H\ z5dH'Ǚ{N=d\D֠PjBp ''M0 4dl3M$r#t-DͰqQs0:[Y&D1f.T/)7oG)%DAg &s,?T μ^QYkI댘yB_X3!̤URbK%F@#ZjuB4h4?+#}@aA?9XgA,sÈր` d>%enD Z84!yڃSI\&N10n mϠ"~qK.~wι4?#i tsQI ~95|X ڜMPN~;P CM#9Da??Ch/<*;ܯЩ{_^έQm A|׊7o!BtƢn P[܀oӹg_]O`-Ă8-Î߮BU޿V-u -vQV%QA=x u^:#ml gQ[)N+ae=Kp*@r1~J|kHhY4 {:b,`|0=Ϭh.^0Mhѕցs70Oq!ªC-s1.Lh833]—n3 Bm(3l`̒. '=l =%zx:?qW$t/V A?ԡ;n\x߶0OlS0h; P0Tq~4g t(X/,QD_q{3xJ<&|Lje͉}'PQQ@q0zW%y Ҥ̒b{x\* QMz"wq@s%>|nZCjf!+m+EQEqހB{*a+j$S:(XKe$]Tjyy2S|[Z qC,HD /Π$YXv$aJvG {6DJVh sx L elgSʅ5?SV0l_&RG fa:q!rzOy;R4<sS4~C1^8q0KĮBY2}#Aٙa؏4.ʠq`5m-(> |j56loTvS)Єd[zbJ?=?VpE]k]o)>$IQ]‰90hi!NL~_TO1[>12'M8$@2>z& v%5)eՎtښ;%ٚT1Eſ6qƟ vD8~><0WA3& bU J6+"&0pY* 4VNy35YDIxZ¢Gۈzl_sJYGbO:S0KsLtx=CdiˆO,4_;tZם1˾/50 u' F Q~u0}2D_*]߀W₅qNPW`utB=ťZgN/Й.d(h$t*_ rI$l(y) &l`D/D t$bV朼1*M{г ]%|˄G;4@ FOY:X(=:ϽƏ@C/0Μ}q+ C<[3jOWi(N Fthe4ѴGGϬ bX#XtfNW)w.}M1}ۗVcG0=Ra S;lmfErҹVgCr%O/ ?~Br& 8pGwŁP*⣝n04SEP85<@ovCot:挳U}/Ie{[ꍡ!ws)Eɐ? FaxLvϹXʷZW;DhxMO $x2ΜⲌcq [J/& ?8ZvX~g}NRS}n ]6+O5E^0UV[ 06"dS\4U^/҇p:|`t'2~_ch]Y6E>Oendstream endobj 297 0 obj << /Filter /FlateDecode /Length 1596 >> stream xWKoF7[Wˠ-$U{zeZf*I;"w):$5/ NIW89:y]})c%qNʪJJ%Ҝd[.E7 NPDI1*C=;i\h_'*T$oϫ $0*)KGp!Uw!j~9d^YFLphu2O1**#+wL69ch TJg3T59 TBq%AQPG!hAez:G7aUw|9[kV i,r,:_,C@Pq\9kn alେȹR6 G lF % q)9OȜ%*xI!uMIlMa 37:N*%L% ߳6qp#CW=szGuItW.Ai%M[Swp$N3 ڭ , b "> stream x[Msܸs-!`a+JRr}5cFKRH$%ٵJ`4F d_Ϫ_}=]<+%Ki+/ߝ.ܰsti:<\~ƚ%(E%쪸Tef-Æb\8u7o.rD,GRՕ rlإW mnfB ūf?fjS=%THUc~j*YʺԊW/~9Zk 4PUҞ_u]|I֔syY}UVqES|h^}7?*]6}O*2MB\5N>aSYZ#f߬*aڷM,?埠~{ f^?y86 wԝR*XRIGg(G9=*DN(=V)zEY(@|dfp2*LE~ ed=`Z=>+|1p(p^ƍ3M5 'X,~pu&od8{35`)5bNE7+Kqrc =0ʺ\ó2Y<\MoȤ]3$;`zV1`w^q,7iJ&~i0<[3q ?ں ǀc,m*j^\vjDljgZsA>fFƶH9n|1ܳ"hm)~v Vjjw'+Mѻ-`S;('8kEP+؞ypM}3|BzѤ* [ga~n)CP-Ŧ,vBs8ƪ-Y>uȚ4y)F^2y( I~(40JV&|n4Ln(8 0` :tAJ:)|S ;߁[}z6*8o4kF4#5 ")-؟}k-/&hsVujnmiz֫36K~q8zBrMP2rɞɔE3E2A=V+=]w j`]LDtqz4A270ӌDL2 ] ӊ-m܊rF]f4Od5d3+8g8KWLȣ$s?ܡ8n(h_B d/ # sL 6Q¬bumdT숁('84)j3}[ |A4,|~!@1'MWi~פ`cb&4ÉK"*Ab35PسSsZ@$ [S1ZR.(Qo3uʉq%LVȟxVvN'6K= D4.pN38WHnY&HC~,ܾ_׼>]- l! h-7[^#F.?6XF?K(?(6;*Y0'Da;ix4D;dNcVĕ- q%6]®Ri]"MlA|+0H=*Ҹ(Pu#Ȱ(Ec0bfʹ.,Y0#Jb.V벽h̥x_e%~EF2~ט 0wF5x 6g)vݵ`s,[WkMI#]'Ϲ|5rHV3 Oc1ǰO7ҐW^1-$Ֆ qpiUi ,UFDG]9]V a8[9rn h*y c}dHշU7Tpw}j)n ,'8G1H/?E2ȟVˏxUhD|()y@p c00 ZN{}0|ʰV}xAe?l~y(4P\D/yދ@\mFLɨ4r< ꤠs1))Sޔ}amcbdMyx2w&w~|.2M-3#iLP3mΤd %? QJIlRRTo>-9U\Nrsh[z8/PsE%gcX&20K"x+ׇRoR`̔5_X󜚎{RR:t&)\ _>qkeP HKg=kOMLfٖPC7C<鳮зN-n41-^p8D5[Dun%etz؈j&7[3R*A$-sP`E7w 0B`8$Y7͚:M"4:$-:/8o-"#֠1ifg-X%\'ø ctsF]?JlQߴE"C}gR>m?NF9ol :4Jx܄ Fr_E<)“UXVqjJ߰Ղ".Ҁ7Y`xϊ Dx; F@JNr IXcnv:EJyEgQTN]BY^#xR|yOlFW֔.6 }d=NoT $d[\&l ,djeM3 RS6 *VAbyBtRZA6ڦzc"icdg8;q_~D*c)%ݝĤ Bmc# LN^1)M|ok5yAPW"WK?RAun\TXPZ+ $lR\ Qgp~9@ϓendstream endobj 299 0 obj << /Filter /FlateDecode /Length 1099 >> stream xW[s6~WVщB;mgv;CgggvK&5I{$ gz`!M)1 2&x e~H(;ƚ:THH%%S*Liܠ_X$$ jc4։BiܯDVH3i7$I$o*@DCphI8Y(6)H:G!!4RwO _' UynH\ 8Aɗ&_ 4XcKb5 ӏAO+2rccο'*cEU()OdfLSM޾s(H-…C$6 7kޘb3<)"r]hZbپ>捓:/0u⻺~l2~g] VxB.AV5v|A+Dq\@=CƲhۢڌ?U]-|qLjA T[?!eh]C /]L[?K,ҚǟvbiWwfQ{5la(Nal'/n&2入@M`%V %([uL)PZʣP$e-.TWkҦE4!ώ AM+IC$je5>j \F? U]7If5M:uꦄɒ^Vu)pW3 lgOU71{m#F9533CJsi@i5ymlw>J!9(ifܚ:i' 8:f1cYO;`Dz\n(G9~ljYԼz:ei2e|QuI (3 Wߘ^$pAms=zr u5Ơ5;"6FTpPUBua #`-{Py4F3;]NbEF_]$# T2qɾ$KO"!I,=rR1I:R&}S~9DXS"L`ei![敹u_. AHH,Ei@endstream endobj 300 0 obj << /Filter /FlateDecode /Length 2952 >> stream xZ[~߿))R}ND#D9d 5^SUꫯ.wd Wjs}ѷ) ߔrlsOa6F <]o/_`òB0rVea+Ö۲b\T UݛϗuDҕqRuh}ݤ;!$nR<;lweVXMMM{ tRpgv {߃ƸA}ݱ2b 8.p Y\x| t ƐPOS%TaIn .1$8`D:bMQqK08dȏt7?6Q_Ms?F}$h1Q*M?sSIw0To4kOwN䷇/.&TF:7p_z Im@ಏD8!|.{BNjfH&HTt}{e, u 8ʱ!Xhf1Zv8`IvE4cANRc• Bz%6D݁).+ԍEW鐚QBe IRF^B#!r $w]pQv| DxÈ.ZK=@9p gT7+<$FN0儨= f:_`Ջ˖$Tj6Q[(.ያR@? Z8L&q'GPL !(Xg3 1}{ A;^ Xdmt3ϧJ6&Fx%}KyADh_3GfcT64HcF]tU0Q!X< "Kfv6B7C(,`'M,M9[T~ )h.AhJL򤙇01L0:eќ# rf_|a|1 (dM0PN;ؼYI(s6<3lƥ>:-^Nh+ȔƭAkלs<}0PZ!jǩStd)(ǬN9 /VuK4f]HuBJϪMv)M&0]*Wws=SfSK;*<72ӗZTϦ:Sl,"" y"5ϸctƟ1nv!S}H-`Cir^&A 3$oDVTǐfVEO;<04ҟ@="p)쓬*$ɭ&tկX4wr%a=:K%A0SyD +C8%y$6oAcbbc;f=TCtYI=ɱ+ϟCtixOk}4Q(BhHΡ9)0SG uţPL Ȃ9 ɱN̸w-<ڠ|~]q |T](P j HB$ma$DYi?L-,-㸥:|f'+P5pyS}Tv:/}&*TxV41CXWy0N:AՐD~^פ[51LK yM^Y\L5 'q/x?9ԒTm7=i.m'=fui0o45XZ6V~k$Y|AHEX0P F_B:oZPgN pq</;t!Dq܇ M+{P)R/R+ zL /.tusfӨj+&ѽNjUb *zᑥdɪ|keZ&~rIE1%;Νds`0sRt HZ-ݑe\DQPBnIb~7GE--u#6ӻ$;.vFRfb_W-@QflrORN@*BECpkT> 1* xɏA%0AJbV /vx%]Bzd~nj,TC(?7a Q;`?> stream xW]o0}Whų NjJmʞ>8 $٦ـJSlsͽ vAʹwp9֏=OSF H`7s- Yanv^K}bcB ADm d#s w}8C8d7-BvA*WބI4&zcpm[S)Q |[Y.`m PPZȹrBR DkiBk=q{xHIC HL_iY({3D[\XRtL ws'Hv)w,5ƿZYM8օUENsnH|g'!Ke2eD:zx * 8ɢR箆~&&^zjuô6Zj&iZ mڱ”.OKڧS*2#SY4<)ϡ Y2/yN$ʕ#;>B;6NSx0 gIVJ%{l'r}!-ۙgےmRv?հU@;z_}qpSNixӛmM;d-cni? ~S4 1r8 |ۯ?0vt)Uf_7lxٴho~ԩM1nB:d4Eqm%3ҿvap?.purĴA;rszc{ҫ1BPݘ7/ߧ)̇!USŴ:7ހ.gonEHU 7ލgt c2koM%@4q^96endstream endobj 302 0 obj << /Filter /FlateDecode /Length 1836 >> stream xXI6?0| ]q'Q@' i=98Jd+L~}ɤ,AbCqegx۟{si9Loo$LOwςDLP9\f0yysP/(%V-pݞ,Vm34qk"\eTPжNɋVZ3<O.2SIH ug9&Ȕ &;.Vg઩6Eޯ΁856<ϙ7@!5D{k",l7HW3%&)7#k?v,va1l`S!7=yT/ L34cjsN4saei!_N?-iřLrHH II)ty(vvB\P#=gu:! g/GTGB!uvH:i"Y2 (tD 6B!F1PK|5Ħg驢!2m[h+IIk< ~l Sum.}W3٭f[h6vNGiweip{Xˡ"df<ˁ s34s-6 +ln-ijWb e8V][SM}U=^jYG>Ug6XKaUفN5.Pang;SL2~N$ :&_mɀCBU n!(A;!eD~LA2.p'mȿf.f1DKbi;EUa* ( ENwqA-@Za݅(6$ZYN5zzqFX{ɘ?eL@Vd(L9$h SFGqs$P=zZKzDue]ך24a1l ,6 eSCõdA.HV9אug:Jq9àB3߾Dzk˸T| L2MfӥUd|KEr ]bB]l⏥ N,4), 1xl9dڬ(w%=P^@iL4~ARk;4϶mvA,D !C pTtgo;HApݱU&bT) pPpd -J 3Ԍv--2hfь)y1FMLzԛ`>XQB8ݵ>sh&d˴?NL_!3hRx.(T-f2$}XE-D#jzF!7s;H rz1®7U.6m`AG4w5lVJV}AG~@M{Ez/ Iس<`+tu# &G0/E(\P־q^!Ucݷ {eOl!Ƞ>S&[k?(ߞYhJ`^itr#!]K+CLRE$atz$ʊ9AZg@6Q}GR~>G=IfTK5\Seq½-)ev8$0#9;ALkNZ給ƀ*{'}ڠ:nE2V#qjS?vjͭ/416a}!vvXE)c $+:t^2/^ Rb\w! D¶wg<;M_OYOndstream endobj 303 0 obj << /Filter /FlateDecode /Length 1514 >> stream xXKoFWeUH,6$E- T`@V"\Jr$N{) +rv73$Ki{efnF%V&34Y]0S$yjLV h|T+MsUFW7(dxf!}V?%)bKL+V|cz5{31&!I{ A$g,͔q?/%iFrtgpRti}[)w mR~+['S 7J'_`j$UR>h/ѐ e0sҢId.-',5dבʹrASɅS#Zfϗ KaRGR9 FrŶk'c42m8Tg {T|{=лMHa+ޢ,uYwHȇ Yws{Q]|0+XdH m&`ț惁hQZZJΧMMAF! Sw(i,}-)g4YLT\4ܶ %K2 3MWMQV@"u ^~P4 dߡ߻]{wb(:(]{ꚝu%O,kr0)jp~ѮH^}z 8x|}';tnU4KkLpk[SU)Y݋mbrjuNqS&^NȈb;Q̐ƽQL)hɶv0ڸ UK<6:`4 vU~PαV}Vr¸XAQTP;! DBˠmnZʪkj0.~!nc91,Njo~1*9=w_gy6 gne*ߠ'|<(NtEO:!"ح/q/f K4=6)ySiSC=|{ BΑ%O{_]"0ه@rpE@T~UQdzœZnU瘮<<6y5)2{y?N 8蕅Û \endstream endobj 304 0 obj << /Filter /FlateDecode /Length 3626 >> stream xZKs))<'7JJ.)'Aa].Gڇ;"0̃F'۲*ٲZn-.wRFJW9Y%li(S:E-L6,,D)* .׋aUUش+nˊqUW%Tq<[z#R:–JW.fu!%?hmҟՅ7)^mVˬŮncpSTŋ/X 숪*u=k+/\dRPڟ_o䦒9t Y'uҲҮho*!.PUUgM;.Hж8B9,T$n ^\gemsPxP 71*'ɥ˽5Oǥ!SBuY+ì&L)1^*L~XYOATDzr x8 x9\]X ?-.$QS &J%\=:`V (Vi9p(27]'&7U*`Nq@ńȘ+ 6ʬ=}ȥ@)8Иr HܬI}+,n6)}SM2U@i^nMzMv++nPX]*ک9{y9+6=i -͵+Zosxh"D@h,E< 0åf,*js:MiU!QݤV督OTL:rhV`FiШ)~XYT-d>ptdt, 1Sֺ"Ckc]9 3=2\ɴ$%[ av aTɸ ޟp7Y0.FOg(~\|A0qqKĺcSDplhۙ9ɦx_Gfw+ IVΧ=L:l|Ds$٤:\@1X8}IL4F@nn*քr2dДaf&)wU)gq lLyU+FJ .33,d"?ȁQOB9!=)IFIgt.|ac06)J G)BkmT+>Gk.])C]trM"NӞc}' ̢E$\ocD4Ź='ї$xY)U7/?/YJL>=w9K!P@CAW/7-I g/jPQ ɺ߾BOLbˌUUիx Q| A#OAd{WJ6x#)Y:FMU`x9E[v#-rRBRzx.<-cl?GՄ Ӵ-RK#^ ]B)1B|xRo9 1uE11D [0r?;AvvY_ŀ/v>爱w_XsJB7۴k|w윦l} W" ;PdDKa3r_l.koqӟ#AѢ<hP]MQ)a$jP>PRJ S4+F>BA3j%KA۶M3U{Sx* tTb͡kGj )IT-&(ʰ3*ǮuWTE.ƾx% ~ o|AFK9T a?Ǡ;6S xH7-6!$v)b0oB>-ivpǑ,4l-ŗC08}`P0D4kR%,zs誨s S}rj{< ,Z^$A|ӼKf=DFܰ2v̂aUstt;ww!$dg_:vy Pr^r]STgUftcxQiѣ BoTAzwK}Klrc"sG),]Ӷq0m'6D瓯GB>=s tνjoUiȳ]j'zAG| ^1Dt`1(w` -~f&B*"g\ Z?uc^18WyoyxRip[S 9ĐO ~`q$ZPF'N|M!aEN}/P` 40ta><%: +ؠgp *.Dļ*vMuT<^6"3 G{;HI;]bmkC0>Ι{##"pQ{rݞlty5R|N0I7 4iXuɫˁC @4$}rz}0-o/2(If٘ >ARBG;;ig~QЕF>yx)t#lďWp20"?UD_T2,IՀ+iU1B&I5+2o٣8U i8$4&L)y^Fǝ{s~7)n?Hd1d{s,!)8aGtʔk#ch^ \xNaOM:_'b6xkrfOxPnxA/4UiW\xGEIS85!U"<)l`߽LMkI?Fo)N z(lBɴ 5^e+.{ 1=_T'<l=0y8qźA fn|h(a A4>\/a;\~nd.^ݩ(@ IOLJ*H.Di+eC6oo7}SFL8!nZ'␧1LӔr|@6687>{}\݋CGq@]a{5`&#λ!t,Hi5 (C @8=ov#싮ϋ oendstream endobj 305 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 345 >> stream xcd`ab`dd74 JM/I, f!CL N\|<<,+={ #cxz~s~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+k;/,/I-KI+)6d```Tg`b`bdd ˾*Yq\X9CxB>M{-.{Є={vOkywiNp]b 8{bL?g݂I=z\3endstream endobj 306 0 obj << /Filter /FlateDecode /Length 494 >> stream xS[k0~ׯMar5/h4nMSl~%8 ?X>֧s!+@`m{ݯoo4l}-B8V\C-5\Bs1[iQsnmԛ,'XSp_b')4+%@&tĹBK>NA) B&ʶӿOR$&ٍ?e C~vTʱAw}&IJ;nBwFO /~wk#гJV6}f !]5(eh>EsMPiQLތi?ہ-b̀LiXmi$}hF=2N@ITdd7;/}?U뇪Z;)ʓ:ۨA ƠP7υCχJj9ieRD۠X$2> ;=!6id6Tb_m tq{n;[k> stream xWKo6E Te RR(A}$ZΐԊPcK7̐9_|58~v.7ߖ_N,RI=_nfDb7l.yYJ*l F%g]!,e\hɏdS/@=2#-Ն^ϳbBg*VM*R*<,ƒu5Lp[%eU S45)rv:408ޏa-e!g䌟 -u%eΗofL?u"@r?$y"Vcaɶ;^xw:PTO>,ժ޿'ۺ;'պ}Q,4t%nwKQ'ݮwFE@"';sd?L>i)DG:LmG!и'5##C:]4SV8 1WKedȹRȅRjsG>T()UjWM/@}10gGOy5p;dq?$~gwjᰠHfUZZÊƈdyYi \{#yq/ЎZz j*cДf`I&Ζ8S_ 8mA j}ozkF찆cO(d1!RQQykCrtFg iь(5RD}2)KZrT_lr}~΋i*NBA =Q%&M3>IwզTWrhػ_3uGֽ%=l.v`)xy 彏#d[7]{]=l/ b rQÇCAY:8[ qZJ_f=endstream endobj 308 0 obj << /Filter /FlateDecode /Length 2410 >> stream xZߏ۸~PXo,pi@%n_6yЮ^V"iHIr٢9|3 O<wY>>ͨ{;Wٟjo2[:_:gg빖:\W kQ2riQԋ%,FU"q5m;$E&j0X<[ AK.3!%3 >,piadBػ_:˕"m˂FiM!hE˶NI$MOٖo7Tu qMv }^0r('R= TNr1pؖu+Wܐ2JacR.&.vdfI'#InӚ~=#:YL V!_bDwL X~Vn[<:vj3M V<duΈފ%dsݴaW>  V7>Z=KI|:} Q2,6w1<#$C1vӝXJ4r!*LAFۢf^2F3|`7V8&N~BF2Z5>D- z!Vq\%M+~]ɚwN1\cr\ &(b*n)Qh`F?wcqw&Ժq21l8$"C@Ap9'bE&l;NIpG$ϩE (\B@ a(#oiiقAсϜ*Y\cSYu2w,Pv첛T?kRAJ0=Jmy **3ֶ)'z օs L *Bf^ѴIn03Bq$c@5qE0NCb~;n Y FM-U;B9-0Sk$i+URKH!lO#ރ( Bc-ЬAy} Z Εa^CXCCpSUfG=n(la 9yA&~UyfhWp.3͔_nU[Ieh#ӛ14 vC?¡=!@A6fWw;gm$X.kk.&]uآiɅv)zBpcaM[ ИIX ̤jZEhÇܤmOb'KL[Nk%S+D_n}F+qB K''T &[uztu^')Lr %(JB{ˏ|՗uZBC|jĘzb,rv+,:tށ!8IP2QBxmMYo7dMdwv'l1Йx-*1ݩr}ճv vy689K'NfBC\lj୳[.sQW[aBh3cj!DRn ܡa\%NÐ!Xuw(7vrKT떽wW~YuspT& yLĹVM{&9^F7'aݝݸR![zZxV]RN3ˆOWZʤcܧ:n͹3L9HOsS|}A1bV[ghm⇠eIV]wv)4:?.t w%Xv!Y4fL^Y=Y2xî98Sd۫cnJ}J>Q9hi65_5 :* Ϊe»nӒg )-< 5ckQ{Gеa/nMoHk6W&О9=~m6e?>i$!{gx7{]7R?m}r2PeGƮZ8#ܲҩCC=Sd 'h"OtW)鮃t|C[&+9! H{ ͅ+CuO?ueendstream endobj 309 0 obj << /Filter /FlateDecode /Length 3339 >> stream xZK_HuT&KR%R)U6RpHb`_f.D_7"",YlϾ1zwg~Ry͙[*so8eb!bp95:,8Q"eIݒgq¸S"TT7[xYts^/WRJT]xI\e:vEW.p/~V4X'ڈ}2VM2]3o[su_<*Ay&"+t.@z"Js@A횢 n/pq(a㛫?QFE5յ;[2"hiwQ9mP7nCTw?bUYߙ[{`"N[ AjӨD̮Đ9~ CX/ˏg5.'p[4MiG1`+6lv.蔊r S4[lJ?qXu5~V`Wy`a:>%%S;6AHm[mN&S>/ 1Zal(.ɢ P\2 " J Jt\h[sЃ+8Ŋ|gbN46mS ԅ4>`F~uMy.l&W~G U:2qm%_ tRG@n 1j/WJg2zk 3!($T'"Q ~D4 ܕ35R7QQAkz ٟȴO<(mE6`f1,ҖKl fP%"s8s=dIpIϙzYl+ڠۯv;cQ6n}[ ] >I+ZdgY,2&EA1,:-:*FmأcB t9Xt9 r#LFM.u <"ӣ )FK0 C(YL r{T }D+}V|>ɿ]()>wkGpSGW:aD{@h@njs 5x$ 0%~l11$H)"{}XR)dKV&z6tAZ j Ce鹻G J_AA 2w /* *Pf াpK^n**tPgP3lDJT= ~wq&#΅[刃L+:YETx7ׇqtIZޡ{ ͖YHЌ;!$#AC@orçsG=𜰪ފ|x? _͇:LD}Xf\ vvŴLD~cBzpXJkjѥ?lMrͰ=q4t@N<*ƥ 1<h=:) 4.![IP;]iN0^fR"q r(,Щg5i~BG&jTaG0ȋIL~3Lw'yZ ye\Zy NAGqc;3|g!=7S :YrԬaYvd=9 U D)zR<#@IYupr̄|(Ĵl:e!{ـx߿:2jkq2Niy2NJ=uPr(WTGތp?/A _}{ `~YVsL*sN:jӨCP?]Vp`}{XH|ؗ|jDrz37Ӕd$ /oCX''hzLFQsxg^,ͷcՇQ1E3ll"d=fj,P9qp5Ÿ@}q:̉e#)8U@dBeT_3ɩ=&h9*$Lb Q&5'_ c۷_ʴ摏|VhqJ;OF8J2WN$r!gT84fAjnx}$IR4Y0'GF"2zA( \evídsJutt1[aM4sL]_d^41՜eY,Xtx?4̢LMidzYcfmzlFn%(H!GHfeFo2b69Ej_՟{T_J4︎n@7bX2*CƒXRHqdL_8q˩q K|G P$Xg%1@->j[$ZX_c-TQyO': OM_& wO`w+Au?о͘f_ww_r MyXQ2.5fG,B v\V;zvX0 0FUpwuu\9M_UWܱ>ܗM[Y J; ے`17-Uԅyӿ_l\w͇?ߖ+& tۖYOs􆊆V(qp: 6Z键v; `Ŭ?P^꾔4MF $tb Aqi $ƹCX ^ \hjo5x:J[(TzP0я~ %A|摼mJv^f;,G( ٛ!9Rz_muoNBrpwX Rڻ=JWz(_|endstream endobj 310 0 obj << /Filter /FlateDecode /Length 4374 >> stream x[Yȑ~`86fA[Q7="<33<>@M#AHwgfUE:Z; 4̬<8}*"SD+,#ה9;B,8%彠1@W3jb`:2E iN\fG$?Hi*q{L5 N~нh.۫3=Q{O~3?dqs@4'7QPa'㄂p`Z^<]\ HF@] g~N} &U#ZR-ʗˢ\H6/$Zz%+OI0>9n!52EQ+ ^ZO:%Q: ?e|XJG3\{ G@W%W|0pN>uWxFՠE?HOW -F(Х~mZg1o>@ S1.fOL^XjI}.[ nd-bT^msudJ%kPGk Nq-58Aȵ|wW<_絕4jO_4zY"TyrV@X 9槠 J%3]zz{EYr=2 Hd!&=7f=#y}1}ZHFD,?tA O`a," d^Jx}@OD&M5D&ry}Oix:sOF(?5!%ţc$UGݎm|>E*x R  i6 |=vy:Xd3G (q ѱ{4iI)0( ?"uya OSobO4Uki )@}N\iRfIQʜ 1$A@ aSI)pUƩH*-"D$dwaڤ4Ĝ1YoX1/1=@0?yH Zzw??F@mn 1sn,DKɢlG8uVzL9J%T*aQ*y6u*(!?]Q$К>b5j $5Y d\*R!B?/ Tyz{g?/n?nx5p  %֍wj|DTdVLʀ[~a5å 9)j9H733!LeA C -,AACS ᏆA=nV-x1GPAtzǧ1 *TºLe[OZ1<-H,䱁K(S (LmqHʗʚU줆>EdM!F6oXu-IYiPIuݿ]c0bt,$_ȣ5>ix9ڢy-L .a1%ݰy^3e+e$ᔘS,տsOicLyչ09eS.DuR(J.A-V"1m ]q|_[0}o_UſϗOĩݶdCfo~7wQڟ'oi佟w~@>IQ0oM3 %Y!U=z*Z%waa.5`;zpbdqȐrH\~)>A*BO# /G?:*z|zAVR=WdjPF:VYSHlnۆK`=Ֆ̃ 0Uj4K [yky338VpשBC> stream x}Kwq^a69܁7v{q5E< FR&6I%~ P 3srJ/ Bo/OUxo"S/?o.~?~3QG8o^IxZ>/z#׋wӻ˫pu*t>F?>럏vG|tpx^3T)q-h߾:xW=sxEq")^<c9_H3DځupnFp&oA1@! QUmhΣWz*G:zrNI:LJY9W7q.9WhEmȳiI_$zd,t皭 A Y|Ε;#J`=ZfA:JdʝE蹟["wG%E[8#2_['Ec"1[0Dlz)bJgd`РAЖrea'_#Z)P]-wU_0$$n}Ր cԠ _#ŽY?U=wnd_40~]sd fV`>.) ;)tH_uO/su}ekŬ"C4`$e*k"Їd ?=9+yt2Ua[DYϝu#p"%Ȫ$t"%о*1kgIS ^vBނ:;1R k}Gg#ԴD CWj@"55:5WXjbJ2s(5jD@9`Ԧ߸ј,P!RTJM̔"Zs%S Oɒ.]uG|G ( dH(X'tQ8*RF{AldpGd(O(1 F=DY3G#[b f)y6$̠̂ZGyJșl`  VU̦7٢5 H^۸iak[>A4IYjQ(ց:A"bk%s%Q'=^Ŭ4Y ī1b f)ɍ[ѼbjC8 <3Vx6H9lgʝ,3L-M{͑;-˴LA#L5V)]Xu]gpk28 p 1t : yb1}µG)nL׼2ŀ";!U.G24^ulxYR)42-{f' G0JaBU 9؉I`*#.4!Ȳ H,&Xz*H0:& Ʀ`LQQS(C Qpe+ )Sbwe8(16Z5 w(@J -b+aZW. ^Op((eFiƴM,c2lº7}:|2X=ͼj&2Rt[@]Fq4ٔh &P26mԹDIlj |4QăDs,uy ZlUL#oQ:*Fn` "Oh"C(bDzSlDV+64am0SRw *mJk5"p1(`OjV7{5?Ym78F~*mR Kw6t=deØvyljEBѩ*丩QT嫕Y,g nֵ4 \B.)Մf , O+9Vht:h?=Tu Js^P°e»'סh ᡰeM7j{0$ Bp0IGXQo 9”,> *iX&{ H46!3 d39̉@Uo`\mL2m, "y߲A-n.1-umjU}(:TZUnfZ?%YҌxfдٲ2kIѰ;q JHCdJ4:QehwOѠANHJNrڎ(EM9!ͭDCDɃF(!JQ F ("Ġ(#B7F;&V68 GDR7!R}.(6y#%-.ȅd(YroЏm,-`31ɋU)r6AE*vAB%'!r M 5Bش55Vj-kT3řb s hƻ@0@I`Xy2siFtz=J49!19 Nm#N"'{qBz>ؐ 6rf8i/>(V.Q4![r>u8]wĦ)|JUJz FU< cGuL4ɣ46bW'Ђ,riF gQ"={i6ϑ&7(,FlB!y7e&8U3w jqcSD"E0Ffc35bLp VT;^POl6,@m,礚iA06iIr -\YzG>#JDj[T%(K+!P@kВ(A):Th$&ZI$*[pD9_m{f$-wRF&DuF3 d(LbuM0듌pw %:2iL[+GuMaaCh96112-ܡl ) (blF7Z .)Jf 3 ؜9i&kbr@94؁-o|y:H9&8N!LNK3 C:v8u,m&-GSsqrR7rĉ:uv-d`ԕ| V܉(]tGC̔5jAH,Etq|z|dI ӫ)UM3HY(Eo)kU4vv NP1c"Kəyy,]}oevEx[>g~t>^HH<Ғz'R}J2BzxpKQb>6 ZݴT T^"Vf5ktŠߒsi60;_x\X|Y۔zR9UԄhg (qF_qAi1XdLUT!6wB\hE$_-Hu_BlK+Rv^_4[ضj907R^8.Lț(DB;yu:JoEA[ωSZnȼ{b wJ1*i {^7Jas> DdA*U].&;VXNQ\bE"LёAUDՎrL~Mm%n ]չkv5Ycy- fKN3充˦Ԧ}N+t!e# J!!lҁS0cS9UOkoˬ Vnz W!&U0P&B Q >$ b-7SQ*PU1:mz훈InjbX;=/lxfٲ0 5BTb{~=!{jqzN%"ā^[Gքu9n)Ǭ5 ~TDx |NܢOb>. ErsۂE Fɵr,W!ȹE!<+WL)L\f<`A,P8[9ian7S* NMOkP/cRt,n6Tp(mQE SմiUu$flKjZi~iSii9 9c&kVR@a|MqD7Ջ|%B_Dٴ&a0Vjߝiz1ew#ц\v''%'.]׫FU[̛< %hP/6 t EP"ΰM̎#Kؼ셡))Bh zdA܋YpŅh=+K |EeDg/Hyap(7NhS-uB$dTc5ų#; Ġb\tUjez6Ye-fKPYff̄}ΩRrqvv5js2Y`!1Q8bǛ܊䭶*W5Wup&(C?Q8\~<SQ'p&# al„<&plwBa|\wmK~,O,a> Ic9X8$H=Tw!(N-L집7 MҶO]cL~BdTmSNqx:уq^q LU (pHuWr 9!Fj ͆ͪ͘ΑRzuLI]IpJk7?\icb?׶c5|]lU$>\l?L5\lGg.WJڷIr~׍/!NxM6bQ&VQ$ N2yC䴢wM߮~V̬!N:ds*OwRȤвRD'ycCq@S򥤢gK^Vf3ktšsi&03_XLXxlYیZz^q ?ERXwBI#4+K HK7;,pP"y *^ap됗p8Pȯ }PUPR[I% paUirfSw" xRJkUp\qZ "=6 Jbq9$W;4hXFR yIn9]ͤ5P;ŋ40d1)e9^r[=&846G=^ZK:KSOm:j|2X=ոfK3%L}ᥓaAen3jin8IoeTs\9pJ^;5]yk)I)qL`8Q?qC>x >כ刴 nbE!Hodpm]3Xd!(rĵYٳc9 cCaW\oY2Ώ89K[ҹU(n 8bstj??2fH9iH༘@2Lj/PDɚ/R8yAI+HI1&>xfz`J*NW9#:}nֹo%fzVqy9jNR5e4؜5XS3T={R T: y>POI *zF #S#ίfN89˙ a o$|he7|{*ͅ70wJ|ʏyneu獖/]-u`sGUI ބ+[ Ц8' ^3~P~7nmMboMyWt#8K.tM S}rسIWQkUqCQ9j&D{ds`da=ghL_L7kˣ|(Z/fT{V\l .v|,`g:jE QU7"'J%( }PPO8 U) k% eG/Cf/I)(\?:/,2JWڂ+9Q/d)N3J%pN$W:IZIQGs(R6vbxm&}kfE E1Vfɯl?ktšluIj0_ټXYZ`u)В/A]ͷ.GJblqv9ڨȃ7ERF=8jbAhEAB?=Pf zHa+Q,1 FHjlsuʏsp̜qd.(妸M$DCy) !?=%  1Ss'Iv87_T_T)_CU)___R2TɋiOtO8X(g4V֊QGQVji=siaiSiSii9+ 9q 9f@a#<ا={z5 u!O'k(+̊!H:ʳټol<~$]y\J C?HpbЃ]Px)뮷βgG 5BME^Yc'~ձuqHIEMBD0z1 mQi)QƊg? 2+٣#lN2:6Nxfܠ b/{ zniYǦw6EZQpf[C%lxavPsjj?=JOăVGo-mSf/"tg3rrC~@$|4ʜz5yXQ2u[N Q晡"lq ԓC"w-%+*j[I/n4/#"NX3ʕEL 1ȅIdQ "✅:V=,T~sLʷY(bhiB^`\fP cAsbS:w.Vf;ktštIj0{_ٜXڼYZN|$Qxx~CEϳI4}_Ps$5*y*[Gy fUy,(Z$:gRM_,N,;%(9)_@:B oȹ:rm 1;'D8K 080Bc  )EŪ~ HTs+?ÿTt\P:yJH/E/LjN%M>,i1S%ur?#MGQFfc5Yb,p aV5K^`/lB,Pm,׏S_cS݃/OI^?/~:o#u1 zx?Јf<~&Ըi^8搜(m^CP[4,\o$5C(7q5Gظ`06;tb$Qʂ/" ?R4cF_ a}AmDUFz\eUTEGyW)AX s41,)PGFf_35O-p`F4C6$O|93A_~x_BJa90P|@{ !KO_{Gn޼t>Nޏ'}? !8+ g~+#}[9?=o?חW ]!9"GǏ_4dYۇ3h ?c-O߾cB'޼=o}x~i?.'Zh4y݌o.4rj5[ ZM^В0 E( |Ûo_Wg [1b$hu 5ũwחWW,@[,xO&k~&6/!K% /|YS?]?~{_n?nx V +h@gTs$?R43o/o~-%\맇[S Lx<q|_a$ w#;+\}kk/LtF~ n"z0u _{{?IV׷t0\ZTn 6ϏSy&!04'bثILO?<_Yw߰w}x|\cQK l 仏w篿J 8<&Jzԃ(ˍ5SzB￾OFxbpYl07|3߅ ?!QƿG>N?< GjJVo߽l*eWIU|7?\Oe=ܝ 9k|%ސO%ߞ}u7o ɚq%%'6V4׿vp^j" ?6(p$M k<)8VL< (!z/ǟ>;6&H4k9ؐ{ lj,튟'TS$xq}s}ۭ uGtWח d稜ӷ"tl,(NCYrˣu=`Zg-G%3q- /?c~z{A"er<7rӬﴅ;;pZ]\D W: 2XxK9ߐg[mkWm=1F8;KDhDtKO ^G)zPv~t9z(mV0Бpw?5` S/m!J'5 EtoG'8}?|zy%Yz~}(= s=]?nOK r}ki8piӒ1i'~pFόF,3w`v?k;8箅G*p؟vivixa>qfRO^ł_HS&+IFNkF1ͱU&rJۃl=M?m~wx)zz9T{C"gLӒȭ}̍ =wXyQg0/}`]i˟=NݼOb>\"|񫎮ް&pLN7>>SfǽygN?Օ9(ş3Keɭ}=;ZDөM42r~?U Ǘ(قPTsC^_<ܱDjH}B!8}M6hM_.@oFh]f޾?E3OI=0qz9. ^K0<3E? +w\oo8Ĵ ;LJݔ)lCn',Y 221}v+{ M|9&hMvA(> }İ ($;:yX,}۶!2;m]R[$?2;IގtL6&ӍƢu=KGrdfeYٰ"fO9cs{mL4I*T+g ˴}?ѝOfyu{kx랾>iWB/dh@R*텧%{~dKg |7O3dn9}_nl}Vn$?iUCy:kg͎-oj0g&1*Hd=D ?g9.ϲLlo)'(wx]R#g͵PƯ R*ĹůIWR ,0ɥ|"(꘭Ovdr}&78jnSKq,WEƅ$vyJ61fa8#eaPi6/{?|D)NW-85Grɱ]%fzݿyx$= "o 1xط:9".-F=}/wHE*' i2G|yc @Cn;}j?WfY'C<GV}:q~Z|a,ʹ~ܷ yendstream endobj 312 0 obj << /Filter /FlateDecode /Length 5696 >> stream x\K7_XY*QohbrOa[ev%("|AbH$2|^7n_v\o~:w'u۴^\;VUxىej(psw?êhjs\I_7B}j Q<6mZkCtݶOܮJi\zY /ծ;l_U0~] LEԶLZl^+S{kyaV2v]%U}5[&F{ݕT`]휕nx&Y]BQJmJqtiD ,|2EՍNӈjr I_]IUaٰD7m!,ߊ .0 { g&.Vn.Srq&5e<:VZ+]5Dj{8 \vJ^n%rY9 EwɑWFP3 z (Έ^\t!Gʻ/^[ Xz6V xqz cith~X^."R*hVT.ê16{4wV,#tmLH!׫5`zjmLP+ {}r80{ , +|VkaqZLq>Ccg  p+h5 gs3̡3 dXLC㷫cܯwxcX;xC ^#1e W7 f3V'4 pi."ijHq`Qn,|R2T7""jmX_}k{6E0"JԨ v), ܍O"8 nGrRg}Zbz]6Ƞg>o]*Ж5 SL:6,j=juiO4y-a2|HVZ ǃ*G|Ʒ#q7'$F!ˆip |Zeޒ{u=}>d2AEW@{rZ,BдWw4WTh' ū1dvݰY2 u)("w 5F[3c\NAŸ^qDWju;]3-h%eZm2 ZN&t- !qG!R{L0GP %{}8Cs.C4H(?e6a afc.?q$?l D$j^JLV\ӓȼjy&@6l' E^}L}>Xъ' GC?"wq'ɠ, t2Z 1:="[\G)N3"lzL`RP6s426u/? F/& )|p˾ɶǺc_j*M\4Y~.!VE'"%Vq=ڲ4ؓ9:֞!ЖAX.zox, !?eY`ԟXEuq(<!!@FٜF'hS# jM%E&^p @c X_ϡHR~ƉOgac@Lռ?2X0)H1fy!]ji3x 9l$7KI~Ic<9POd~?#0tͮޓ&[G qb<ڗV'}LU*E$L3H憿(f$؊>#i鮖L'/˟{ MD,&B`,C԰u9)I48ё]X1|"}̜]SX4K2;zB|2RM@&"Ǎ#nYO-C5Dm9 ہHˆ[6 K5 }PL8IFBslZH_bb/1Կ [vS c \#8UPu1{̧|eV1'~@=s- s0-R={)euR^*Ew@qu}Wx)i8%{hccfPyh5ftV;H74Ȅk 5R!)uBAByB9)o?,M8Ƙ H<%۳Z[#c 3VZQv!bs)4-<]OK}{6uN׺"0 !&AtC[:MJI6BSGB ,<J=KDZ:)*?՘q֘95HHL/jΤ+BHP0@4 $":G.<'ՠr̓.B"i`p؇<-eo]"[פʗ"VcZĹLI0| Ǜ\qώp2d:5FڵԯìmFxpW|ΒY W Qq eO#5XNʲOaJl 8L6 2:ShdϾΦ 4 `c@q 0zUrΞZtѕ5K)*KZWpc<I8[<*&C UrII! DB=)4R&krjFR“1K$.e"G?U|W3ɒ>Uua3{.o*cpBTޥqfY[!(!c:&mogݔTZ,E6Ηb: þPhИBɷ?kt{F|0s~}r;Tef$zx;N*U1s#F87$_6?K~v5#`BKo2D:s4j;h_UM=2]@ 8LP؅5SaZH,92h0@^@ VrW{S KK}vL5Y2;N5,˩ ;z{NWaOQ+avM ,d Rg~^Y$0u>FƖ2%ᠬq_RlivYt't>cm\ö[5x ПSPqxK&ې&rHZΚ 5{F;8A ,E,f)utxY8t].MA#ϝ;#3fw=+7Tx91(9놘n @.]73tZJ8v:me&-zw] p57爤itjyŬ&Ӝҵŕa#x]E.ftHb^ePe22Hۋm>:+ڲ_O4eEwJU,i&PE[.䞿~<#Cl4yփZ]CRr<ȯL,v{ȏ'~N%D%H6!B۱@f ԛjt%v!e">\9NU7hͬi_D ; Ed8n#s-~H\ZpiG^ЀҬ,*GgI2f03S|7ft&3?\/[8cp8`\xX=ՆBwH{LU*l٩^Fy_cMr5M;(@%:z) oR~I!WB/D'yZ%h*)ӥ  K솎@^EZ,sU(">gʕ;P8h*Yihz NMܶ k:Cx?\5}V7+i|'.*5s6M- EȸZS[`jajvj݄S_jC}0X~ዳftRCetb3ӡ: s[ .u,$\/khW _B݆~gz=J#NATpvuMjO7q9mJP+v(hbhB %j(xی}7}٩+^~6{EZR4Fb[H#7:8ÿÓ?C2O&3 Cx"\6^..nvB' w$473. p2[LY㴆wK  v ]M.p@Ξb:x(X? 5XSufb>Rt;kC(}!,K> &T?}Çx쎰XOJNi|:izZn٦~?m6ca4 %{EF_/qmv5rBlYwa3~'Ql~34ܢp>=VbHpb=v zPq6ݸy83c*7ߝ endstream endobj 313 0 obj << /Filter /FlateDecode /Length 3607 >> stream xZKs[bYG ĩbDeys])\R $)t T:h iu8Ko~>pό'Im΋<7yR*s; e7`qJ%*Uaw}\7igi)FII#ѯTv6?tTHGi9bZ*$Z៷R-(e\C5D4ibSXϜ lU-sU&)uB<{|Rpyi\|~ #Sѥ<=9}~~q)nT ૺ~Շ} ,s>vPI :) Ny$Wxv_uv۫W3ڿ+ 7g5O ϾKz&g?] !l[η9%Dh)Ѝ-8Q'c^BAKN{12_}Ƒ͓(1`n3E $ *-(\z@FY + e\b-^lfbbdaB.Wf n&L|0JP)xPFy,Kғ$Bfg2_.HRGUӬdR|d@DvʨWLO 1Y΍U! xP_^YVkg;%sQ᎜",n EsO8d½.e*q)޽$V*)~ :7*Px[;Q^fnn|P]uilb{=XҘ> Ny/nm}Yѱbu7v2+|Xd\W.u~J)-siQ$wV%VtCBY``๾} R**YNmChWNHKDi5xthy@QJe/wgߟK 41@\m.SbkT)+qHR||p.ij3Mù$XȓկUw=`yp 8o%斩VKr󿉌 ( DT(gSݸ.GnRt"i{tNЉϟ?̥K (:Lc=US ud܈wZ/7p LdO/+gz]'_fkhTi}5f#f^37O%/~ c Z7":uڌEp(o"4P1utTJP|mR/C6Er0 PYQ)4=WTVNY@*$%?,@)@ktu碽{>0ccz4)? 1?9H0 cԑi%j*!yhmjF+Ĕ%"j;U\*aBaNbm N&G[m-31;u+&0kDŽ= iS?"vI-я|?lXP%1x؆~(V"K)wjYR@sB42d  c3C*nCrQ n"˥E!N:|1bvjr7bz'=@Dҡ\ ߵEI'/gĽ(Q]Qy5[?ע¢qTpJYz{5uht(k+KCiJk)SϬS"L:l^A }w v>zEmO1Νopba9YBц26*:MWhBih|58p3K5^RYbPvq->87299ԥSS AϴTEئs ޯe 5|< /Zw:w:eIO 3nEari ݷq\xD٣ZFU$>]N /F!x%i~ qET(udA)yu2wA%TP4*gTWAG S iƣp3ܱi+9w,Ȩ(h;p1 JsYqNiT٭8g9ŠW5{=ib@5:DI(iJZjQAj)?,qҝPxL}AFw+"U:żK"!=%;2o{KIuzX餏Și~bvд 'J(2BX|aIc!ZTiCjGPG]r ~#Y bBDƣeظ~QMļ-^8:Y2=J3Q#ue}wj>]~a xʽ4 QZDR{>1vcƱyJH9,}4+pP@E{GI#|:&JGXb*{b1F*:EF>hX"Lhaһmdq`i5aty/Syx7j5+~gQܴ<≻}):ڻ2sEwx?Tq“4ODv=LbYC8}(]LiV- H}t/VKS^(0nM ?B>Cnendstream endobj 314 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 548 >> stream xcd`ab`dd N+64uIf!C0VY~'YXnnC?G ~(_PYQ`d`` $-*ˋ3R|ˁ y I9i i ! A Az(qT``aX(} }'wuRGENl!WPWՐՐѕ;'yg܁/N]'^ٽ}EÊ%U8z;'uO3a7ӳfM̜ٛխޭRV֭ѭP%O7toY?c5sqނ//}(JwŅu~*m}۩Y6v;;Nw 4?ӧoͶquggfn{i %͟ӽR4рrž~cα Stᏸ93].-.b}`ĉ==}=zxxM}xxnendstream endobj 315 0 obj << /Filter /FlateDecode /Length 858 >> stream xVݏ6 _ݡ\$(k1`(=] _?+]-SH?HS*8u߻M"U)FvM:O~H4OZHAnЦV[Q&a?B;pƱ]6G;rްzGg1Vm+$GtZLYG6O'^A:NwS0r* Zj.@*DwlCY^̪".+XdM\+/]x~>~neJ9]VpխazB]{r-cK,q0k|2/ş`8wrGH r _׿=COݺjaVCy '\"v)*5QP*>=h1ִ>[4mA-F#$k ~:"u v51d&׵Ϩ>|,L?OQ@7}^Tk}=}UUC8>ΛF ; =KuCU~ujНSZq)@>L#0 3P#َd7!zÝ;n`DmT0;%z5r+Q[h컑Mo@WZԀn.9䠹xyQ[ְY%W UG]8"D5h̻n؍ TYr_oofpspJ<<0߄qMju%z> stream x}[9n}R_t>8W$^g=@.\ζS=daAzf dØ-+J|HQEO ûyoy~Q;Ikǵ>j#:sy_#ҟ+z?[O]>6>&!Z:y_+^|t5|çXU_"iО7;Ьi?~*Sm<~#C?CO&xw<}|WȏHOoB(;7i&=H7o7ޕ2֣Pߓ_Nj4 I" :ZQw˘9l9>Dh fF{?2s+$YM4ӀIedctX,4 Rh2{FڦN{Q*ujd@)(FH?Ԫ> $ "RH`c,fVʣ{MFFCjǑ-rP6 DՉ@!@5"aHԞ4FƬ`'E(!MshJA!I Tx\Qiy*ʬ!tSTU,.8 8Id=5"RA`ssLF㪌S"ohy JզI+>h?xFJ6&)&JAohUam*ǙD.ZsQ'J;'Ht_k~d~ɶAOWل*3lb0* #)> &*kWsM2oB6M+-<5>ӥ4v + ̨0|:ۙF>?ȃ&GR)>(C!.*Y$FF8ˇsbis.-3AM㣤@Y"T$bƤ܄5ieGm,P퐵/tMV5!Z"u~I*]'9NNM5E6WY+L6 |JΐNj&V"{n'g%“YA>ڌ0#-(r*2ϟ,hBjXahj|ajAD5zJ'CS'L\'kP W$( T$A@:vQkhxW1g&p.Qd iSlF6B1fʒ0(= (!TyAJ &Y)ǺZ>1rN[)Nab4r$ w_` S*_ҾC`>rѐ088|˜V6␱K*J%9MCc>Fi+: DV׭k4PT롕Zs6|f.YKjh;`6+3sgvƎ|En.qs:M(.(KC)6Nqyf {mE ;R^xG aGڅϐ26ʇܪZi52YP8u)*a/9cW]! ~ Jq,w\Q*Q8nWR t|/5sK>rU5rɁqcՁP ,"~)4PTHxf_>OnmNȝɹK\xrA JH sB9CSC<3&O$ yUԼi0)ϒ J%J<Q "Oڌ!'Ph$G(1Bʰ^)=fG)uIJ+DyO@MB=0(c0vM9)Lh~GگѶ"4z,+R7LkqZ} +J cּ) |)3PTʌ9Ͷ||f.٨˩fP;\6Ґ]oc̐{*QzfeaԲN"mY(,h9+R*gЄogvLAC}rΓe.Fft~T=-e6rk1E2 8OlEֹș&ˬW q4Yڸ@@s HXt)Qڅ:40̞6M.dc]5K`xq.dEs\ؐrG9˅1iO@ \W0~3PT硕Eଶ㽛}]R 0cwlB86i3nIΏr]$]Aȍ ӯsjnJ^֐!N7}I~p*JFe2%`"#F\4B&'E/k E*-q#$;s^@@K"D|c^-Ѕ)r^47lr>0'&L a.{^R'K'0@ Q2PGi+ lv㽛m\ QءPSwl686c3fn.bxE3L"ښ~aEJs$@E) DZ+:$=s>0}Ef5dgL{ƺn$?x@U(( E"-T&tP B  V6N-(WU'tL9)l!e8z"TkR 4yzl;ԬfNE6(L"JƚT7 n*T͜aTJ棫N5I{412qnH$a)iIQKR^c[~vY|PcyrAiG-FgUsS35UIrG( yCDIY8}ƾE9): U2pf<޻ЌХ0CuIKPK?pd8|1}Jf@Y#hO>S*? 'j뚪wP2v4%6ƌM%P0EOIVRՅReMV#G'y e+%IN`=]Rq‹O3Sg)_VTnNabLrHLlpB5Q\I!6A4VC_ jjjڹb*1P !'c-bA;ћ(]j3R5Ϗ)\NǤЎٝ<5,8HD9X\2}ә7AyaK e>¢HjUxeY<')D9 i-IKͪgIPlMnʕ)\FaaQ+2~cɮ)r)UB>L-`+xT|x"ಖ.)+ J}Ȥ]!B{OY츈0XzA ,ML- @mMr͝-!,]5#)6£xkh]Ji^%b''"R8]7QJa}4?lJ.2jY/T e 9Jl>FodDaKغ.MbmFh<{V Sm| j)M'qKA+RRΕBAQ*O%- !ũU \\p;7v$oYgҴ|k@Z}Ҧ)Eѧۃ"g(@(IFMA۶|@%r]fOOk|sWQ[(琚_sR,eO վP( ǺHVm\U{OuJqvMќW-p?v ^!?_YbqZ;׃"f]:.n#4t)L]R5dlڌqϬJz~vWWv^jfjѦ6?Վbԩ%єv]bMKg|U) l-jV-)YFPZ r'5JRՑssB%4 I23ivu^P!-.,mX hjUPbTR#Ţ-m޺@vɜ᫸ 9({n, 飣%9  3O+lF㽛a j.#Pp4m8:\)Uh\:{bt= !=f p'?@81la ys@`<H 2*}An\MTŐ*[H zh%ys EݮV 6/) _AQu?.( _:hq]¶zG+xssN>h:םC8&ʎi?C%%MK62/-8r.mWMoKI.kE*=8_g2ufAKo-)E&k񩄫M(sͱ#(f@@=]9U9sLc;^?Z[ે(Wtބ^uHpb]iJ;e>/QM첪]nJȇm&tjf%AWLRh%GZoZD) CKZAZf_|!OG6Ag0ծڜӎBRX)&>=rKZ\_5UTeI8c3LhBfƎes1یrTT\QPGiesƃK'v_}Ux[OWI|pq̜7No_}UYHG\DS颠#'7Wj{\TaXG%Ku87뱇ފ 8Joޞʅ,_wހ{[Ҋ/8~xӧxO/4#pߋ7p{1lġ4ge߼~w>m~vk(3{z>ӷ^uרiC]_^s8A\݄o?=KȹYxԠq~ ~w?8Iˌ3{{"i4Ta0-÷|Zqif^\F)ϯ@;gb̷+ K:^pc}z;.OVYD>~̵PZ/|FT_pt~`g@/L#kܲaDޒ&Hd ( Zbm Sxco(!ԏ }:BX YB @pNv;FvϝUKܼecV\IJ*qPGJ;K^JD)vd#X`&^TKj 9)jiɠ2ZRaZG)rTΒnᐌˏr@ۇ݄ݰ㪬@!mލk *rdr)~Yt*bQx9^ Ҥq/|tUKy7Rcl]BWy8jAC f$(%H(cA!Y# mE)ʇ1AWLi;3RDE _+O,0 VKPGdBDDeD2tva; %l(ǐe48 Yr)ǷR %rt,xrg(Ջ[>t7r ݗ\MG%&#xmvż-=3><w?T&}jڵY,E0+u)͒ vGf#jQ?3hfuJמf o{"Y6̫I΁!!J;\"H]E;\b,mbB@]l e/C77\U)rB(|` G O *~S*Gؑ1MĽ'?Gc?D@Qr-7@1Ԙ8\ Y!Z[&|wF ANޑ21@*x3qF.bD-PpMR'|%̥$!'-av&y\tKxProav?4Qc,Pf Qzl5.j6g50:3?Lԥ4+v$- G̪bў-}npI XSsxf;31MlǓbcMF ֭b[+Ɖ%uY1N)pZ>Osa UI꾞5g r+)Ylup^I>]=y/,126|0SQ>뢤Q όi^` kH9E]f{Esdϒ: dQkEҤQ2ukX$(-(Hx{hsM<ZЊ5.(UVY8g`?;|uk.jGA+_`Ԣ0dM"O"5q(F)򨇾]WOT,s~O(Sq0 Mnt :ĹpԐriKyk)roeftw3/Kaf꒚);j펗~Q]}Z9] $C =@jv3|^_',T9 -@>fֳ q8!#@~LJz$"|ly  g^uF ggsD$p6/p'((5BjQ C1f3fsJ=" ff}NT*<.ɇJwpFpKqGsDӃ>EuZ)13cGcGR3ƱM13j@+S~pibTA蕯׎- يl'Qܣ{Eڎ]]oz$>_b9ݹbN(T ;"`} k4R,(IjK:u=@[.D ,g?##|@ǺǯԣU_oU>ZpQtkĵsvPs ^*peut+/J::W<4Rts3/ afz4Kv(Z6!3i 3Z"a2U\\__EFs)Y4֙Y:.K(WllB3oVy ޵m[=l)vMjJhedssv-z)/].ǂ{vZS[(}ުp+V!Uq9b09dHf{ w_4CzAt" Q/FzV=:tg2ufe|r*޴~r/r$:AqÜjlQ7*vے+VV4OI*6S97\HJ|R|5̦eIm0%yԕ)rP(vPs_鉽gF}I!/FIӖq0Ғ+o88D8Q9þ~4 FJ]xbdKݧ^"|x0Bk˵HTG@QVj,tnugfYer@x:e*\UnY1VQ!-g]asq߯A}1W,-٦U)[V [\ewDzhEߓMaW[{^ǐ]~$pT=R%wy9PG$m6iI!%U2o M+:uqEr3 QEO) S(4RD鱕F,㝫} N]NeSir,58U%5?ɵ8ޅP_)jEF)7H{1#!d+6Yn"Nw.,6C³CGRksiܔ 5䚍3<~E Qʢ9%@Av|WW͌:5(&blŠiAK|楢jt42k8\`_)1MXtyA3ɴJAc~'k캑U;rpݹF<~>|M_|pRݑJKֽJA+A<qM)Rt\]<-Ȕ}cI3ZPs_,,>* Ŭ¡#VY9E1 eQմDG -H witYgwF\Gr(1PT06ժ|xfw.٦iP;V6^t4»OW7Co InrJK9# /id}mDr@;?HMɚ {szW$|tQkgL:\5rSږުqU܆ޥ8#D7u]Ƈ7l..8T\ƬJѿdفHLO68J{6ܧJ%yJ\ƛw;_-SvE ;6W&-'erG(ƸixTqm2)>dPDCx/(~k~AEe);kpοڃb 2/S ^pGaJ4rcj>4yBw ^pq8]zր0۹ mY_5@AQ>4@jfп< h˶J N07UK -]d7~=~tICW_)ÿ~7ß+K_GEn_$ O?go>aD)z=F?~?ٮ~y/x h_wok?#k?G$^7~S)׼q}9}6,+]65j틸{ CxoYu}?2- 珗/ݴsZϗ~ ,O0V2oZ?a~5Y˟_T|jqYMVW?_||yGCL/8rendstream endobj 317 0 obj << /Filter /FlateDecode /Length 5861 >> stream xu\Km_-?QX,'qqdad!۸k4G[K<|dotGo^㇗d>o_}x? bʵʏ߿+Q:]cq-jo/~O{>]<|~z\k_Тz~˻ީոSiNۇo_e}x+eu%zZUwzUW.0_yBm^,( ֕5/|ԹX Jc:?QEE]##=#ja&}^_~|U4FؽNoʀ`ؾk,ޕ5xzR@ KRrʔu5~UlUR6o-7SZg}Zy> ZyM`3 L`;6d`g+t^EOؙ_5Dgd7?Cc>S4 yiӂҚڿDlĺjc?ϱG HJnf ( w!UIU P*q bEchXY ~g1'੍g( %AgR킵0* ''Eܫa /B\1Z붂VʼnL3IW23s 0i؂`)?7jCh! )KA i`̃y1CP5E=N3p#6k4Z2N e05XW'/$ X p* 81Voe'3@ i~\qian`DG(aPOX=Ao8w:#l ~Й5UP"?88l%CuP4&oHЁʻE0?v 0wlģBgo  /DX>Uvv8*(g\e=;}΁u`*lpD#GOT/*oIz2M~[a'6o HР H]NYɺM6Fld,2$2]`Uu@Զo$@FT'g<38'[:DHSJ+/Ů͊,dKvV L;e=T'%9Ѝ۲Ĭj I2v6QM<.IBM8uKΊaxԐn#gXHH 0nZl16՟$#$gSXVW8z>8 @>u:c ;8V$C}:vу>bz8Π[ k'kȩYyġ%VmBttNߍXI KɲXB0"_ I/bD9b$rJe(81 ͥ:RJ F|ɏY(@d9/N2fS*R(/I-~I]H4e!G,GYFS .&?3KK#hQ2W5D*E>+a-K_bG)LN[a](+ơ9r 9OA eۂ R5| Ld۲IGYdI2B@u\@@ $$zs*f`R҆טT]Di1|y] NyXrSVdc\#q. ׄ74\(MfL>TkMG3_Tr՟pqjyP/3.eؐ_Jve8‘TxM rlhT$nq=5ٯ!UDR2GiNEB>9*l ~n?!U:\aW} Bc׹%xq !ƴC IkۭDv>v02ءF۬n{R$nl%4eD*Ye7g@'E E$9}'S?^ BWqW؏ZU]Ur|$d)?Ԭm9KSOl= TB@*q9 wObE$8<Ը2 ~ۊ9;@ۍe[T43]ne5_F BU@H#2RT%7[ڍpw$pGm~JUD~8uGA#Wݍ1߳󼩁O?MUs:U~r8+ݸ6 Fnm鎖zFsF|{ (Ru͉K일JPZ"041bJ *r="Lͮs}5Tkא$Ҵ.M\l1e@ # ^LBrpEo1~ʌoY)8N&f0"ђѪҸVF눚1JʽI)՜uP^ؾƍVȱ9nVT2-ߤ`9ԦWJtC&G ij(Lmwdp=r(ZPU:oU- TBZEP*Z{(rO4\,,I/xjDKhD祝h+Qv:ZV】2-.ZR=C"eYɒ8FAS|R]+Cu=i8pY`uHQ$F* vMIt jb}(`7~DZg2(U2jܢD-JW=Z w+"^>wIӺȮ_iDEɈ+3RR8 ݄ͶfA5 q@2h[Fl. l9V_~2cDTb5Lb̼ӥO>#%L8X67ͰtOpaOm˜klwJWxop+ٛo) :w)ߑu@9v~Üo!A-F2ү/!O|fU:;Dl7u -y,_8ƏOo-XA*m=5dζfU1ûw#~@288(_lmGCMy #ϲ %5Q>3J.jcjCcE.Mʂ'>\-6" Wm#(e|rA}Ū@ҹrOS+W\G)ih A2ѢjmDIu[1F#*NN1̕c ܫT79Up s_Q ( @Кk3PL%3M,+gD0 R$Z Q9Q̘ N{ is 5B) =+YYLl]JH&dqBs%"$]  C7"¤I}r )%&S $cK)&vΦ,ҏb:] ZIfK2{&qزY#Q d_RZ7D!׺(XRu0n{ ҋc4Ʋ[鑪-IJ _āmme+GZQYhgEXL'ls;29݊n/sA=hf$صw>q5ˎXiPbahx~Lwjڳ~4wn*^ïZs+!Q%}6AZ2ֈw!J)[ ii;osH஑}1.#$̆n@ԩ%|IrymQ'FK[&W>::|Ipe XTMr|ü֭_r 6>ǁ٢@I%i*^2 Մհsf{A-YA e~79X},:ӳ,Z漁"BVJL0MiZJ^D'ds9 S|:m0FiY6{'I,D !e`]X;ܘXfY2i]1EgPwEF%FagϲZyܶ&Psi74 Yd0PTkID|aDPԊQC2v֔01nV]߿d)>zy^z/cn[e5q {`x.R?Š-7~?009endstream endobj 318 0 obj << /Filter /FlateDecode /Length 16635 >> stream x}Yseq{ b.fGx"(JZl=~uMH@@Qr:nCjpNUVfVVO/ܿ ^U ^/j 3^/F赟g_r|z9s뷯~wzΡ<<_q1SO'q-Lo/J)x}w.r.X0htw|pxf~~|ы Z=ls M@;},6i΋ /O9)ٞʡ(\>?R>Ǽ?e#S/aݠߞk c - &ѤWB8b-te+piVQq?T\3VbW Dr+ӿ"kybKh>,tބ1S*% 5*фS,o+4(`$A m@(G _w  *1Ii;e+Kaz/+s uR*:-3fXHř!. ,?hheIa+dtڝ"*"B\RYpmaTs:I1yئ#:Sd "b AE:_cc!AQnVQ}$"ޏ":3^U" Sg9^X.Yg鱚H~*:N0Mc$ g| hYӀEbH>  9&diV(QqB2$9Y*F2RPɵ)x`'$$*O"QhA~K}t 88 /3w}0|$Om`f6&Yjef8$wn2Im$~k'1V4=H a>(m0M"`姓"oJ|k >M. IO#@i α6g `Yt蓘f>s30) rp2tЙAL}PʃhIf,TI^9L*Mb*sLH0Y`;!uA!`ǃ劰9@.5`"L"΄K/UIhTvC"DKz]D\\:+KH .ݲ ľ6"Ey IYt . DIgY@Jvy* ~ׇYa3 (Yp4 s!i .(1MCE\Xu1C]g`2@q⒈kuOq3(+!Pս\=S-@Lc@hN*銃لhQjϪюqQ&1ag'aeюi;p bZKTv (y)P 7!dQH;$4|US2v٠d^ S6 ąd2&p:n"Xގ!DԞL:aU2Dr=Zg+:FF ȥ:kM^hzt/4O `Stx6SK\͍ifO?0ӑ|9~ )~KQaDnk 0G3UL'X?e x_DamQx֧7OӡӈorC u1x  /A4: Iu'3GQcN'Kv1Wr- \XH[WUiDā \|Y3Ek3QMBDV?Z#+BOf7?Y(,_UW !m VV!B0c^6}$Bol8g"xaC!S'HsʄJe*/|!vhFcJm]tM0RPЃp14'#< 4g44*gi{ Mpì̅R 5"L(+h^Lj7֪jX92r~fL7EW: 69gYJNV` }, >X.%Q;f0spVdmF,qci`{U#Z.T._,wYCDY`b2",8ƶɞa )(!Qq5M!=yߛ%;!lLuOM2bL7ѾTTOzGO0䎞О *N^/ V&+r!Q^ 9P`foAM+HNӰ81MfSVi} H <yLUhGK Vu¤0=f"ˆ3?Phd sXi@RӦn$_&T9hD5QQ ,hQU5dʠ=E%`6_ @ 8V 4\u6u^O <+Pv$(FAޚD0@00&G+ K$a rN2G[S jQZXfF iph^&ϳ(6-.fiD#Cޒ4T9U,ndR ދAV\Ffzv $.4{4и'Y/oiCäZبe]yªdmp6j**I+PiDPpHA ;ט3&kd$cJ0 Ez Ḓ)gմA3MѰ{qcU <S,^  å'Oq,Au_Բ6nFSSkdHJeޠ*lz$mZr,0p&$tf4OR!8) T )C1PrL$Baٙ\`=Md M@#0( %|'!kޢ)Tњr9鑦)k юB}g.uK!E&OQ!mu$vUP6MlZ*r{O,@xQ@blT~tSK %E!4v*֊#%`j\Pf? # +TIkDf[Щrئ'AnPTP];$AcQ-Vy#RuQuFa3!8hL.bavЛ]ů.gVd.1Sv1.7dwHқ,0DJd/ @2XCxq`c`7#5WP|%uVq۶1OV$:'@-",4ÀEv/}8@䭤q53i(gsX|}[n[$~[:GSD5Z^\1p׈fs1YQMpZ%-+Y^۽qQ\4zۦ`V-w+F< ĪIhX *ȹӚ=8 Y&g;7G'2Ǻ(H4F?:'"XL trBR"oZL#=g&:zkyx+d V'>HH@N8X^MBnWGU" 7lK8DM hD +:ܳFf\rL }wEIs8C)̯IY9DY5)زbA4 hm[`S'f@x,c"jܽ EI3bGU}a"B'dG7X;[ǨآF oۃk14>Hb gKgۊ̣ŏqت&5e|* [YԊ6z9gZR<:51xhZs@8<Ճ+Ht!3(,,xz@~hU:D:>mF]^N ܢNf vnj8'Q A4K\X2 ~+Ve4)Y~ " RXS$U"02[6* 3YvKUv, $<-IQœSzH0SM[ U;ɍ)Kdq0 Qi:L#7W%e^PjwjW-`T YDl"=ӴgSs1#Zv7,ݔRXhF1)Scl:>X# K$Z<2쑺?g&>5LCRq"%+^fkgKӊ m&P8xGIJGhbdQEG nJO7ɽƯZ}ƛWnPۊЬbp.q#C0JaĢ^B} <ͫ|g``H+nzhRoI. f+kzmw)>gt8VЎ{UM-͋jpA 1 $1wlqM[š-]vWcj@+&#oᡈnUi_,!INpVi%O/Еph}B-!Fl2 ֶ;A 3H}|=025YNK֔P[qu[):"^R&VWT[{Pv^PN_ðPjfafhubE9j0|QjXdWξ* d 1搱^ԫV ."nTصHMK"ibhedkQ"׈ jVٗ.Sn:;(zamDI,RT 1o,\Fa'D3IS5<)[t&jvڦ%cTY T0,i8 X;92Śg-3[{0]46^0>_pʇe!N"ZijԶB\Jg$y4-]3Hjva,ȥj9dkF4VUTsHjEEpQu*kZP׊*B@Tq ePnksbVmftwյe E&ހ }_zVc#uX<,{ÞVd1[ = ⺡nfۨn=ۨ:-1R4G&1RX"9>L:_dRX3ՍƆkƪSgg`;T?9w?]N0~zq dvU>S`42lh!vr9duFkzͥ@ʩ%1v^' 5#(YFցGz NxX8P5CdJ2e oFr HIV鳤dplm *&)ԍ 0\]Qn:a A蹍}/Ws] @ ҵO /; vj`-$H6ĘYdծ|dSG-jDhv"tZj@[oq ԏ&nx&Mȷ20{b>0Ʒs״%ICg*@VSpmTJ;rXF;6ssba<*<"y Agϔn')By]ss;gm궰=PiLޑă#UTkisQ+9kqc1ڄڧq…q—S7vmz,=kV\ܪ4>6i1=pgZݣԞ,l9Qw|V]nER o&\%hN[]ĸ4HPF[]zl3 ٵT\6vaM[.< 0G7lQz7cd pGFUڧIS|)DnAD 9@{s\KRP*Q]AK#GUi#mtQ{aDҔ'oՅv](nL8tdβ5y]|HyxM;KK\\$ #oj3 m0% RG:E/%HeGb/̚4oR#7<_:HC8 !h'-x3&g"pEKz{nR s'jƱrɛj$:ݢJ/[ۭm }|lm*-5..Khv lWKx (;0wZnͫۤ2Vpz=&+?O?,u,a oE\UJ_,[\.)9BuȾvK-Mt`vф>xnGcU30}>7Q?kTC#QZB:#UB-)g6ꑯ X-Dmۑ!4;p(.x;Qt$!,?S,SVȚ]mU}Ts ;NҰA6i/BG1_'6^o;eV Bc cϵQc c0; vX@9]jB#yZT_3`zp3cdo5VIrtmQ'Tm֘3-XĮ" ͺءt'h.Fׄ|X>,n1 @i>+_;.j.|?YX/cD5:j< A; K.ި.*˪ҚՄQKj}(iᅪ Լyyֶt̒$hBҭ|R.*[KFIԆ]6^Oa!IZ& %KMa[4DkȋՑj$CHJn#J1Ěؘf-nT[{0\4^06wtIXӢ($)ClTDb$\ST:"5P+vW$=P[%Ixc}K;F,) 3WTӪ*T-B{(mVR /D&@F RTkKɵVvs:lbo;ҵhFJ$}j ss,H_F5>&_.: پczP~rK2 wd'I4V6RX3߬Սkƣk 0; vd{9QNS\jɛ4 }Zph]#YЀ~F lA !Xo$@I+fڢkwD]d>L KZTɇ^Q c(CXe-X`rC;k3I$6|$7_tq5=R=Rc-T+rTnMw.KCMN1KїOQu02$+sR%F3O;s9΀ gRߧ3™eQ'n)a"-==މ!h`[m= ֝SZ 5N%6ܪ^ :\mS0)Dc[d 1)D^݊65hjL}fYȗnpwY6ZɽcJ 5Kwʬ;Fy?ӌ` $m)tӫ}1@}B nT.уB8h6vj( 0N'rZ#SK-mf囵pu{[[߶Gcc+; v`P9]n5>FYje}SmnR[ ǾޚeM\ŬWVaۢ1N۬E$ᆉ E-*(ZWfwR0m@dw ɚVGkA]m;@{+&?ꎈp,7tjp4وrw<&=134}x-5Cy 'h,mtS7mGO ۦ65k+>jU=NIT=yOYbll7Z)-m/T/tQpiqrpOS:XA͒~O+q 43Io.{ZGHRmczWMevI>G&4D%ҭqe(5%W}{˾kfƷ4JWh3vQChp&[;61| " V0߈RV#YOg|X ˎ0K2ڶJTI<+"w|Nl-ۈ}e3;bYwpwpqrw6Z=CNj?RЖ%HV5jW}:#rJAzAXVJUMFcFcXZd;.&RDz-^DuHǩm3m"s _%)%eh/q'+QLT'5 ZI,p&,[|(h5'EZ8V'6D_/cy` @cµ cԵQc 0; [gC Ml\>qtq *4n q'Ψ!aUK?F (ycg F [J[] :^|=GZO;M6/_m{E?OKS\Q縲On {y;]tD5%Yɽ6Ml[%/}n}[yin=' ;!{K@`ŰZ %kT!?xo)_w_ BAM*/</\QXpnGjK. n\OܰSS`GIg]kS붷&=aחv;bGӷ5<xhOs'pMpi_yrQ[+[Vgwp'i̾|d} ) p:heF+"8=% 'Xgn4\06]5Vv\/tىX(S'IcF>IE> d2ISkVlrŢ*o;I˝ z&nd+kI|tjMkpvi.Fxn ISB$,bD#8[o3wc6ngS>$vo k;@so8O;CpFɹuDoLk%| L2:)h_\M *Ǎ21 GkTjTq1+9ku.966~C7 ˪~G8j{ ʼnFA>QǤ#\_X= cH[i5v=#|ګ#{>L%k5Y#1!_ fOnwZuo"t)I]Dov\XWhS1h8 o{hcp[LVCOR $t-|; |N?00a_}i-.upSZQ+BEi'rJ執u#B-e맲ZXlAh\vavjܼa0fbaN:]F(_X4?51eߴD +ZE52,k&<ֻ<լYKoϢa%=HG:A-W˦76bT*>%sV"Ե2lt%pQTZ"\ri)n[WFGJ-3n<9ZN[+Y;3攭QaK ;Ȇ8ՋmVxs Kkb㜵qׂ8pԷi0^_igfϕe N[ˠv FKAlMd$7$6ED .M{jf#|y_5Z,@@>Z q!G^p`abf/.&wKDIbiy"O5 _yh\ijP:si#-v?e|/TpprSAr]<<[sNOo8S7 }ɾJ:*AzbMl7ZM(}';*@,ڡYX(3eQϾ'/(Δ)xdWKĞed!uxaVuJJn"}~ 9tkQk>cuy[.nՆrܚ|p-8Hע`km+dfU\*`Ǩv׼SFG?<$y4֪੦95Zۗ[ҽ)Xǡ|%y_IW11ִ9kiqڂqڦqB2–Q;3 ~֧DĩW$s)GTf\:]rf~EΜvF; 0&]V6128 OqחԊH!],y|XG>C0"P/'ck;xC`ϐw"g6t Gt46|-s3H,m%/uhP̫ b|A!خv_;v*_ 2 #7, Gq'W:0Ws/ [ys6(n6!Cq z*_ӃWb^F@YR!_([C VvM;`}^MLcY;$׉6hi5?'XG4cm|raX{F4}#'/|M`76D2:ˆm0]F]dё唒MZ؇P}^粇7<9=.?BpFt#Q&FkOp]N??}w\9~}#B< kEF>Mo葌xz>wdtRՐPSBsonx`7oo\ߝ~|!SBU!}d_?>rE6MA֕ a9]?}C ?)z D`XR vLs*]28#W>mZwoq5|.k=G"|$(.ҁz$?zg<ۃ0N7n޿a'Iɓ\Fgof4~A9[t솄wϷod; Jb44/nޞ?|xz|WWx"N/dF"֝Qb0Pu"'߽m}3rk'QnK-v{b< g_#tᓳWpp6 1)zt 4ѱ{zxs+gIEPTB }?>$1GLBߠk Ŏ( $ jH/LĨz9ۯ*n,]n#?ݼ}S\QE'i7,=_X΢h6EB.q?QԼ48!ܺХۧ]Ry69h" ϳ$Rܮ8 fL 8vv|?/^Si oi $RX .y8|Hz9}=r}۝@:mIgR&&G3Ol/xl/2$tza[s=@I'z _7:ј\?_1iGwG;]F qq|^w43쨥ֈ\q[׿zQ _n>7x󛛿(Ģt4a=||<w 'Qb5Ng"8p*n<Q沝tdv:KKH7Plpu {aq t#i_\He:=bTDYZ;cga-D#  hyD>>fr@CD'#NG)a.>ῼ>E\endstream endobj 319 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3713 >> stream xWyTvqTAP& *, ̨ DŸo *q7 E1. (če M4Wj8@s朩骺}˘aX5 IIJ\hr,m$9V#d&Af&6elt=jh+Vd,MM˴pe8_lSV/MU:AVJufR5mg&WR ÌX1ueઠi3ׄfe'.IMLZtqٮc<_^xBڤ?}Pt# Bt Nn:D~JBIyUk՛fӇB v@6/J77GIg6a&|tH8>/GO;H0 ;?d;qVj85 դSK25^';a$˭xQhbzlTT{DL1+ ֌+_#޽9 h.?~ujUTR? rQ훹Sʒ=#fLyaZQpZ `|!p,!J=,OZx?'p d9#[W@|Ov갍Nig9)(  (Ht"yԉDINd/Ntu*8"N M7OM&1DJs;P>>q낒扃W5ȉ _Og g/خ< ۥtx.pön.8[[eyR~O z-[}[^~Xx>ʬzpz6L$S[4Pa+([>.jJHI"ż%@o` iq)TV#1yN|@X $w塢Iz2v:vz>oNJX1 `ŞW=J[oEBeJ /x9?7m^;&?Yh{0I{b&rkoč_mF_"AJ낫&9UzWvnO'Ҋx~kjg麜?\> Q߸:D tVS ,K: a)kn/ڧ{hG^*O-שnPUOȋ5G֠袶 D9ud%^Fݹj|!JnB$d e`"JV洄[Q}jөׅmĝoo؎C]=auN9"I!vĕ%90@jgsImeJ"'D .d<~#H #ftڷC w1%ZZP4ܹ#/܎Q4kw/eJFCBN{e Ұv{"pCU\g' /I0T9lc 0Wb /'*@K 9rʂspTC aJD$8k+K|p \ڱM'z֞xVsLjܯPgC&49T~q}"kaB=UGT:p,7qz8v UfQY+-?=]APz9!3d(!tn%( %g%Qg|Qܑ+\Uھ B-uN$M0ݘ ^ZZ|$x{hmyGͻ!޼u;k/$>ƠH3R/n{'+ wfXt%ދNz㥶+uY`peܛk grwJ %MZ3vZ^Ԑ-WZ2RL0pbM'- -WP*DBseߜ\ 7Gnz^ZXh SE2U S?a!b4Ԃ/U\E`@ӔSƿ0NĖXun^Un%!3PZt1Qx7#*;Λ_nkv ŗP4NY@g~vgHendstream endobj 320 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2302 >> stream xU Piii؝*u VeֳF1*:(xp#I * h+8ҥ]]Kgugwow(:Vuu'"\z"c~`F0:F{OzCěq oy B+Z1HpK'iB,}\3S.9.&V'?v,X'W#UV'WG|}Ap'Q#crR8z}9M{oM~Tz|򵼔b*w";)$W#2f:sLVb d\L Jre{eM`g5!oGŅ;*s)e&4yij9t [p8XMk0A1[|ŧ৮Yg-vUBPxj6#):}z{ೝ7P|:P"dnHY Y^! M-/!3V">C? L$8$B$MdMHVedws}Kw}-tA$xv$1B7tс$i?=A9Pc1D"YH&Sjl&?8U (́|*ۜcȋm,VUe1 <u,Ⱥ繯sƛGncH%vYѣq_ބBı ӥ.(BWNG ' T9ޜ-㦘Jk}3-y `>S #j eϘZh -w/~sj)hCK<9G@!{6̦[[Yd4qű@yP*KTZ6ø1 Z='|k(ߗF.ffLH<#dAΌ%Pf˨lβRRaY*,"YKnnmmn>uyu(٫?8XT>s|D0KEu/,/4w|<9((|[i C *>ٜcJ +֠ʣn{{2xNw#X'ԧ(ikΞ$~\*~1h٪`EBV:C9~T_&ӣA;Yt,> !Z#Zn_5&T.VWd-pJ?FljSi3R6na*2,JkQeqnVl/3tfw7.3yfpez,ָ7׃;|sEv7ܼrsQ+zO{endstream endobj 321 0 obj << /Filter /FlateDecode /Length 4119 >> stream x[sܶS>y ϣ fL:$5:JN IYVwwX'I"yb]&8M{?IN'zj\O9?y&%.R_)422?ͳ<.evz?y^8 Q"Vk)Ӹ,<ϥALʢ_RҬI$Rt-?oV*Ҳ`mh|. FVD~_qW,sfe+"΄vC=M??Cz%W<.z U։I&e2I#1LwYulpGR Q ` [Z!uψViɢ?BD52Io͊<|ቂ} bQ{dWSݱv(Xt-d25bւ9LʼnQVc_d7Fqa_RoL`$ 7(} noyO{ƽqDEK圅j Es*K7T"r(T2hHK An% ĥ,T) .E;/[~%X`~;Yh51ŪE,\8 wڙWQTΈSx%zE4T^Xaů@K'"i ',eį?B,:T,V=v~T)f*9YaȥBG"2w7;֭2M!MO (E&jH/9-!4;KY&6ccM̂c?aXȏ İ41xYf9*b͏oDD{|.<:Nv2TeJ6@G)O7 ;3Qf(GTAZX Y^BZwf䜯qpeNT lj @'6S} dH QukPDnA!#]`4( )0/ t Ii,){߫Xو>*i9Xzflͭg7;G L˓SkOf^,Ë́)c}x56Ep)l!(5RSta<` ۈXڅ(R@?.`bhkyNs g&BǺ̃4X!XMȊyU?u2 R)d>;D_:HyE*tvl "vx0+ZyW,h1yD2h]"ꪣh+5R&TjlHj9 EP䊆ٚ[ gam3T@QWB ,Ғc4i"ƍ,$}^wLՒJ>߬ZF$2F]`qqVI>$}G>]HTO` ţ.IW@%ޅ.ӔcV!P>gj }iq">-bQeRT6P@:Cٻ!hGMBj2؎ ~^>q(UqoJ;1 F)@BabFAMrES aK ' B! 0vxIzրE V[cT} P]J㲲ZI b kf $RNڳUd|( ^ d+fKKĆ>#paa+_i0s[mHv%}{?b7f l(*xÜ|UH*N r93glj}4ښồεqs0?ώͭjO<֧k ݏ%u71R-/#[䃀=3w$Em; L(p Σf,[R^rrCnh{~iA#Cb!eԋHb)TY̎L{m,MP~[Ek_n1 |6_('l`iS{kz(tŒ*7w4_@.h:"LTY% 2$y!~'R%$圽2+nN_VJ|ا );|2OILH~b ڃiȡ#C~[#Gr:동΢(؅ռ.1Y}? B@iӨE7[XcDa"jc Q>csO5oȄUJ0><{^à9")E.' $F}5K+*;"H ݁U(GΖdY8SomxX`F :!5i*Ec0jv҅<<-u4Ki1|ɒ_(t{QЭJC hX%ݱS `>g<у>M_lS"O;ɤ C k[n=?no?IꙧWLGߺAnFiZqdxZY,;b}7Kg /;)~7FD bxE ^.Wk,D88]8Hj"bCsC"bkLP&mOXmh+Yϒ4;*Φdk3ݼ݅ ҵ丠8iNNʊc*k ?CgՒ 9s+u`st~}vA0l+%w u،cԍ;sz1ǹA u31WkXu/4z xX.6Ք aL? &<,{(Կ{ЗE+Y8‹C:hvl@-HfWF*VGB(.KK2.:y fDW\s,zQ. lw]L !v]gvvNj; WsW53հք7pgҬ?]sxbY'\YwqIWӖ4m?ͽ 26@Qs#7D+kdYumb[wqbG^HX2o6/ɖc6Fho:4n6rFiXy"rX3ޛnMw}wj:྾zlLH7?~u Hқxe,;VGo^۟D-Hy)#ã_ akendstream endobj 322 0 obj << /Filter /FlateDecode /Length 3640 >> stream xZK6)AX4$8q\ډ}TY=iSCrx7߷E'v0 4ݍ_7""?r/vg?Qv]gIo2kX_.tQE!LsX+h\Р19tX_='e4d;,YI<\{q}9̤(J]_+_hsg ?T%in 6 Ror/Щ&)JB7sc,3)4[<'>|cY>tK mWp;<{a!(3Vdݻs@Ivv m7R{MS>{WW]v{lr4φ\7/;峟60*/I_k^'U56m#;sqռbz<-7Kk but9y㤩7/'?={pj dK+y=Փ̼$aGtֲ`ab%ʹ,a_&J!V-HA[?,/8^bBRR ckE/` qEI{ 8x#]"3DAɻ7PVQh47H07dxҴK;^0<\]۽x qhX, `2R8*Va^2P>DLBtb'h5V=JF.R!`gGDw]G- @3 oص"J0Zf` לѻls7GN7'kr8e{! _L}d a7jQ:Δ`;v.q P^wJ(Phq^PE==t^+Dv}r4Wޢs+tY53zj pgRi`>B.l nS~ss6,hORL)VT/D* ۣYy!ɫM1\1\ :񙙽7,J#$ڟ!P(Uxϸ'_f{4 :F?4|)GP2 JXMDY@0J~ )2.5.]Ќ%AEQPr'xh: R-OJi/P eԣԵVOAPZ]]nM}if)(K?aLp;,AU+cרcO֏>s* ]Pyy0u`$H4)| Y/M ^N5B҇vC.:.% NC},#+JSK`] s VZyXowEPQ0l6d^cV]]eC@L#Z&=xdPAds .qd F: :0V ,2a!؝GеeʖSN)3!uOmlʤ [9Ý듇dC)FHU",_suR6Nq՜K?|܆ toQY75 m\D5{@cL9K -=-K5GiINY*orٱ|%ikpM=8'A۸xA"i>q*jG-3M2 Ml.cL˸n/TM4av:8ؚ0Ґn aKL1u0tpㅊ!4u?3NZF8Y?8++w. i KӐTL kĦ(âɖ)Yق0{9;ǵ0D9N ]F㰮l+cÝ+[?h,Mzn!>_ס?x2oQYUN CC'HU\&*bmu!$L:Gy5ܻ'8 a' :DN*jOlUT ]DEH"jQzAa̹ O}YAQ3 L&2%únĤ*u cO݁1> ә= nyر|<5XEI9B/́| 0iN q S y> i Ŏgd~*-x[sXrL9ҹ&ȼ4JU6Μ~ -2;ǀdX63M/38?IڞDR &% Ý$8 D:b'<,6Id?ITZꄅa//nO ߅n[ zW~8]퉻P0:K^d@c`vʸ[|Uo+temUpv{CakS2vw[_l5xnmN\&)9;aE_ 9].3(wvݴxmiw6t\Mlc?JMNw7d\K촱[ӸO'=Pu b`]4+ wG>?{TgzGE!!>nλV[g1J^7wjo /և[~d?඿87/ҽ|aiaé~xr)>m!ȟoSw̽.5w vR]nQpH+ FnOjV6˖kN:|:Iendstream endobj 323 0 obj << /Filter /FlateDecode /Length 2548 >> stream xYs۸{AE >Ȧ׎/I'㤶v0"9/.>H$"] uB6/6Gt:o0?:)Ir.aDzNTN曣+hr: TF,Myg;W䇏H4rҶ@$.$U)H/H*_Ff&5d$S Il7ә2,%\kOu=giwƀmSFҳYIW1'UOfYH9y|^׋gJ)7uɭMM]P.W#9x9?{63ӡE \u9_ձ* ]>tDMMޕ ŏ_/Jz3Ogv3+UIϲ=aw\>{{3kbE6ۏm3n{qv F1ey.4϶ G/qg ~g/:ǽh #lզ|[Anlۼl6նhz;d<l/ vmG//:V0fy{7Jz=e{\AN&=0N ˅(u\dC |w4c,Rɬb~ayp@A%t OyaP)Eq(_Fhj˨a4vr+Oet}rFT3b3vb2*ANqb$*q)s^ xv-H9$2* =؊j7ESI=2G$!jm ` Rdr?Z ^:K}ɻC5Iq&ƕ Z]FMJ7C*Km,Ԇcٵ;x{=Ґ06[%&vIH2$m K M(WE?|$N@~g Jf⫐c6t3@BM`Ąs1'$c<`RI~Z L4Cğ 6#V.ĩOơ)`kT'KTooƎ6+t(!Q@Fl#,۔Efކ d |BỊm21={*$u`KcWۺ-Lgv*l )b "20gnRs3`ԶfXt\gO]䙅Yqpj") (n zj7&aPt_@}BPW\HkHѶuhejXnSK C(8Y4]\2Te$nyl<Ʉ m̫c2=,8[dJP/֟,i{BĽQB }l P7Q-glVc=L4WVnokō?1|I0R7Noa"6usg+P u^ubaȓm( !W+ӑ6"'@w[vZ}5Q)aj5)10R&qP,%Sk`0;` \(ĝttPV&ՍW00M &p$uL^*H;e]rs2SGh"sQ=5ISQ,ác p_"%օR@H B3!4M:H|, Dj1Éа\ˆ>?C(;g83BEN6vdL:w9 oQ 9߆ CF3Hʨ7.hhkטr(If] 3=c~@3d ;܉둂?}-[wfཏ S0%CH?yxu^lp >&R̛kop1ޏ~]_8zpisR-NŮ7w`1X xx]#E*vV ҳ> stream xRn0+xj}1P4 rhKd*[ Nd)FT 8{)0L7e(^x|_z3"fQǰ000(N(k!WEUYmIBppc4RYG}_&%相 2r)΅uJo,;Gk-Pi*8vXF :rFNDPͰ̀, 0їsŹ䤄 Pqo?wXA.R,bLQ$S9i- ˟Dhr?c˶>mE=v M(CEzP $_knۢ4Ra$8Ò.:<m>Eƙ-2w7h8mȏm^NTE7ٯC;(XU-Ϩendstream endobj 325 0 obj << /Type /XRef /Length 288 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 326 /ID [<9a4005ea8e442dfeb3f76ab7aa4fe3e6>] >> stream xcb&F~0 $8JP?j ^M#ϠܳM #`m-- A$l)"A$9 RD\`5{@$) 6 dvlA'+|%` Dfui`f2YngQfՃ];=- Dθl9X=-`Hi lKdp0ׁm_ Wn`e,W$8"v`1)01 endstream endobj startxref 241234 %%EOF network/inst/doc/networkVignette.R0000644000176200001440000003061714061532363017021 0ustar liggesusers### R code from vignette source 'networkVignette.Rnw' ################################################### ### code chunk number 1: networkVignette.Rnw:151-153 ################################################### library(network) set.seed(1702) ################################################### ### code chunk number 2: networkVignette.Rnw:171-173 ################################################### data("flo") data("emon") ################################################### ### code chunk number 3: networkVignette.Rnw:184-186 ################################################### net <- network.initialize(5) net ################################################### ### code chunk number 4: networkVignette.Rnw:213-216 ################################################### nmat <- matrix(rbinom(25, 1, 0.5), nr = 5, nc = 5) net <- network(nmat, loops = TRUE) net ################################################### ### code chunk number 5: networkVignette.Rnw:218-219 ################################################### summary(net) ################################################### ### code chunk number 6: networkVignette.Rnw:221-222 ################################################### all(nmat == net[,]) ################################################### ### code chunk number 7: networkVignette.Rnw:234-236 ################################################### net <- as.network(nmat, loops = TRUE) all(nmat == net[,]) ################################################### ### code chunk number 8: networkVignette.Rnw:242-244 ################################################### nflo <- network(flo, directed = FALSE) nflo ################################################### ### code chunk number 9: networkVignette.Rnw:248-253 ################################################### nflo[9,] nflo[9,1] nflo[9,4] is.adjacent(nflo, 9, 1) is.adjacent(nflo, 9, 4) ################################################### ### code chunk number 10: networkVignette.Rnw:260-268 ################################################### network.size(nflo) #Number of vertices network.edgecount(nflo) #Number of edges network.density(nflo) #Network density has.loops(nflo) #Can nflo have loops? is.bipartite(nflo) #Is nflo coded as bipartite? is.directed(nflo) #Is nflo directed? is.hyper(nflo) #Is nflo hypergraphic? is.multiplex(nflo) #Are multiplex edges allowed? ################################################### ### code chunk number 11: networkVignette.Rnw:274-278 ################################################### as.sociomatrix(nflo) all(nflo[,]==as.sociomatrix(nflo)) all(as.matrix(nflo)==as.sociomatrix(nflo)) as.matrix(nflo,matrix.type="edgelist") ################################################### ### code chunk number 12: networkVignette.Rnw:287-305 ################################################### #Add edges to an empty network net <- network.initialize(5,loops=TRUE) net[nmat>0] <- 1 #One way to add edges all(nmat==net[,]) #Should be TRUE net[,] <- 0 #Remove the edges net[,] <- nmat #Not quite kosher, but _will_ work.... all(nmat==net[,]) #Should still be TRUE net[,] <- 0 #Remove the edges for(i in 1:5) #Add the hard way! for(j in 1:5) if(nmat[i,j]) net[i,j] <- 1 all(nmat==net[,]) #Should STILL be TRUE net[,] <- 0 #Remove the edges add.edges(net,row(nmat)[nmat>0],col(nmat)[nmat>0]) all(nmat==net[,]) #When will it all end?? net[,] <- as.numeric(nmat[,]) all(nmat==net[,]) #When will it all end?? ################################################### ### code chunk number 13: networkVignette.Rnw:309-317 ################################################### #Add edges (redux) net<-network.initialize(5) #Create empty graph add.edge(net,2,3) #Create 2->3 edge net[,] #Trust, but verify add.edges(net,c(3,5),c(4,4)) #3 and 5 send ties to 4 net[,] #Again, verify edges net[,2]<-1 #Everyone sends ties to 2 net[,] #Note that loops are not created! ################################################### ### code chunk number 14: networkVignette.Rnw:323-328 ################################################### #Deleting vertices delete.vertices(net,4) #Remove vertex 4 net[,] #It's gone! add.vertices(net,2) #Add two new vertices net[,] #Both are isolates ################################################### ### code chunk number 15: networkVignette.Rnw:334-338 ################################################### #Retrieving edges get.edges(net,1) #Out-edges sent by vertex 1 get.edges(net,2,neighborhood="in") #In-edges to vertex 2 get.edges(net,1,alter=2) #Out-edges from 1 to 2 ################################################### ### code chunk number 16: networkVignette.Rnw:343-347 ################################################### #Retrieving edge IDs get.edgeIDs(net,1) #Same as above, but gets ID numbers get.edgeIDs(net,2,neighborhood="in") get.edgeIDs(net,1,alter=2) ################################################### ### code chunk number 17: networkVignette.Rnw:351-354 ################################################### #Vertex neighborhoods get.neighborhood(net,1) #1's out-neighbors get.neighborhood(net,2,type="in") #2's in-neighbors ################################################### ### code chunk number 18: networkVignette.Rnw:358-364 ################################################### #Deleting edges net[2,3]<-0 #This deletes the 2->3 #edge net[2,3]==0 #Should be TRUE delete.edges(net,get.edgeIDs(net,2,neighborhood="in")) #Remove all->2 net[,] ################################################### ### code chunk number 19: networkVignette.Rnw:376-379 ################################################### net <- network.initialize(5) set.network.attribute(net, "boo", 1:10) net %n% "hoo" <- letters[1:7] ################################################### ### code chunk number 20: networkVignette.Rnw:382-388 ################################################### #List attributes list.network.attributes(net) #Retrieve attributes get.network.attribute(net,"boo") net %n% "hoo" ################################################### ### code chunk number 21: networkVignette.Rnw:392-395 ################################################### #Delete attributes delete.network.attribute(net,"boo") list.network.attributes(net) ################################################### ### code chunk number 22: networkVignette.Rnw:403-417 ################################################### #Add vertex attributes set.vertex.attribute(net,"boo",1:5) #Create a numeric attribute net %v% "hoo" <- letters[1:5] #Now, a character attribute #Listing attributes list.vertex.attributes(net) #List all vertex attributes #Retrieving attributes get.vertex.attribute(net,"boo") #Retrieve 'em net %v% "hoo" #Deleting attributes delete.vertex.attribute(net,"boo") #Remove one list.vertex.attributes(net) #Check to see that it's gone ################################################### ### code chunk number 23: networkVignette.Rnw:426-447 ################################################### #Create a network with some edges net <- network(nmat) #Add attributes set.edge.attribute(net,"boo",sum(nmat):1) set.edge.value(net,"hoo",matrix(1:25,5,5)) #Note: only sets for extant edges! net %e% "woo" <- matrix(rnorm(25),5,5) #Ditto net[,,names.eval="zoo"] <- nmat*6 #Ditto if add.edges!=TRUE #List attributes list.edge.attributes(net) #Retrieving attributes get.edge.attribute(get.edges(net,1),"boo") #Get the attribute for 1's out-edges get.edge.value(net,"hoo") net %e% "woo" as.sociomatrix(net,"zoo") #Deleting attributes delete.edge.attribute(net,"boo") list.edge.attributes(net) ################################################### ### code chunk number 24: networkVignette.Rnw:462-477 ################################################### #Extract location information MtSHloc<-emon$MtStHelens%v%"Location" #Build an incidence matrix based on Local/Non-local/Both placement MtSHimat<-cbind(MtSHloc%in%c("L","B"),MtSHloc%in%c("NL","B")) #Convert incidence matrix to a hypergraph MtSHbyloc<-network(MtSHimat,matrix="incidence",hyper=TRUE,directed=FALSE, loops=TRUE) #Set vertex names, for convenience MtSHbyloc%v%"vertex.names"<-emon$MtStHelens%v%"vertex.names" #Examine the result MtSHbyloc ################################################### ### code chunk number 25: networkVignette.Rnw:489-491 ################################################### plot(nflo, displaylabels = TRUE, boxed.labels = FALSE) plot(nflo, displaylabels = TRUE, mode = "circle") ################################################### ### code chunk number 26: networkVignette.Rnw:502-507 ################################################### op<-par(no.readonly=TRUE) # cache the plot params par(mfcol=c(1,2),mar=c(1,1,1,1),cex=0.5) # adjust margins and text size to fit two panels plot(nflo, displaylabels = TRUE,boxed.labels = TRUE) plot(nflo, displaylabels = TRUE, mode = "circle") par(op) # reset the plot params ################################################### ### code chunk number 27: networkVignette.Rnw:513-514 ################################################### plot(emon$MtSi) ################################################### ### code chunk number 28: networkVignette.Rnw:521-522 ################################################### plot(emon$MtSi) ################################################### ### code chunk number 29: networkVignette.Rnw:532-541 ################################################### library(sna) network.layout.degree <- function(d, layout.par){ id <- degree(d, cmode = "indegree") od <- degree(d, cmode = "outdegree") cbind(id, od) } plot(emon$MtStHelens, mode = "degree", displaylabels = TRUE, boxed.labels = FALSE, suppress.axes = FALSE, label.cex = 0.5, xlab = "Indegree", ylab = "Outdegree", label.col = 3) ################################################### ### code chunk number 30: networkVignette.Rnw:548-551 ################################################### plot(emon$MtStHelens, mode = "degree", displaylabels = TRUE, boxed.labels = FALSE, suppress.axes = FALSE, label.cex = 0.5, xlab = "Indegree", ylab = "Outdegree", label.col = 3) ################################################### ### code chunk number 31: networkVignette.Rnw:559-564 ################################################### plot(MtSHbyloc, displaylabels = TRUE, label = c(network.vertex.names(MtSHbyloc), "Local", "Non-Local"), boxed.labels = FALSE, label.cex = rep(c(0.5, 1), times = c(27, 2)), label.col = rep(c(3, 4), times = c(27, 2)), vertex.col = rep(c(2, 5), times = c(27, 2))) ################################################### ### code chunk number 32: networkVignette.Rnw:573-578 ################################################### plot(MtSHbyloc, displaylabels = TRUE, label = c(network.vertex.names(MtSHbyloc), "Local", "Non-Local"), boxed.labels = FALSE, label.cex = rep(c(0.5, 1), times = c(27, 2)), label.col = rep(c(3, 4), times = c(27, 2)), vertex.col = rep(c(2, 5), times = c(27, 2))) ################################################### ### code chunk number 33: networkVignette.Rnw:718-730 ################################################### rnbernexp <- function(n, nv, p = 0.5, onset.hazard = 1, termination.hazard = 1){ nets <- list() for(i in 1:n) nets[[i]] <- .Call("rnbernexp_R", network.initialize(nv, directed = FALSE), p, onset.hazard, termination.hazard, PACKAGE = "networkapi.example") if(i > 1) nets else nets[[1]] } network/inst/include/0000755000176200001440000000000013357022000014333 5ustar liggesusersnetwork/inst/include/network.h0000644000176200001440000000423013357022000016174 0ustar liggesusers#include #include #ifndef NETWORK_H #define NETWORK_H SEXP (*getListElement)(SEXP list, const char *str); SEXP (*setListElement)(SEXP list, const char *str, SEXP elem); /* Legacy networkapi.h functions */ /* Access functions*/ SEXP (*netGetEdgeAttrib_ptr)(SEXP, int, const char*); SEXP (*netGetEdgeIDs_ptr)(SEXP, int, int, const char*, int); SEXP (*netGetEdges_ptr)(SEXP, int, int, const char*, int); SEXP (*netGetNeighborhood_ptr)(SEXP, int, const char*, int); SEXP (*netGetNetAttrib_ptr)(SEXP, const char*); int (*netHasLoops_ptr)(SEXP); int (*netIsAdj_ptr)(SEXP, int, int, int); int (*netIsDir_ptr)(SEXP); int (*netIsHyper_ptr)(SEXP); int (*netIsLoop_ptr)(SEXP, SEXP); int (*netIsMulti_ptr)(SEXP); int (*netIsNetwork_ptr)(SEXP); int (*netNetEdgecount_ptr)(SEXP, int); int (*netNetSize_ptr)(SEXP); /*Modification functions*/ SEXP (*netAddEdge_ptr)(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); SEXP (*netAddEdges_ptr)(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); SEXP (*netDelEdgeAttrib_ptr)(SEXP, int, const char*); SEXP (*netDelNetAttrib_ptr)(SEXP, const char*); SEXP (*netDelVertexAttrib_ptr)(SEXP, int, const char*); SEXP (*netSetNetAttrib_ptr)(SEXP, const char*, SEXP); SEXP (*netSetVertexAttrib_ptr)(SEXP, const char*, SEXP, int); /*Access functions*/ #define netGetEdgeAttrib (*netGetEdgeAttrib_ptr) #define netGetEdgeIDs (*netGetEdgeIDs_ptr) #define netGetEdges (*netGetEdges_ptr) #define netGetNeighborhood (*netGetNeighborhood_ptr) #define netGetNetAttrib (*netGetNetAttrib_ptr) #define netHasLoops (*netHasLoops_ptr) #define netIsAdj (*netIsAdj_ptr) #define netIsDir (*netIsDir_ptr) #define netIsHyper (*netIsHyper_ptr) #define netIsLoop (*netIsLoop_ptr) #define netIsMulti (*netIsMulti_ptr) #define netIsNetwork (*netIsNetwork_ptr) #define netNetEdgecount (*netNetEdgecount_ptr) #define netNetSize (*netNetSize_ptr) /*Modification functions*/ #define netAddEdge (*netAddEdge_ptr) #define netAddEdges (*netAddEdges_ptr) #define netDelEdgeAttrib (*netDelEdgeAttrib_ptr) #define netDelNetAttrib (*netDelNetAttrib_ptr) #define netDelVertexAttrib (*netDelVertexAttrib_ptr) #define netSetNetAttrib (*netSetNetAttrib_ptr) #define netSetVertexAttrib (*netSetVertexAttrib_ptr) #endif network/inst/include/netregistration.h0000644000176200001440000000470013357022000017726 0ustar liggesusers#include #include #include #include "network.h" #ifndef NETREGISTRATION_H #define NETREGISTRATION_H void netRegisterFunctions(void){ getListElement = (SEXP (*)(SEXP list, const char *str)) R_GetCCallable("network","getListElement"); setListElement = (SEXP (*)(SEXP list, const char *str, SEXP elem)) R_GetCCallable("network","setListElement"); /*Register access routines*/ netGetEdgeAttrib_ptr = (SEXP (*)(SEXP, int, const char*)) R_GetCCallable("network", "getEdgeAttribute"); netGetEdgeIDs_ptr = (SEXP (*)(SEXP, int, int, const char*, int)) R_GetCCallable("network", "getEdgeIDs"); netGetEdges_ptr = (SEXP (*)(SEXP, int, int, const char*, int)) R_GetCCallable("network", "getEdges"); netGetNeighborhood_ptr = (SEXP (*)(SEXP, int, const char*, int)) R_GetCCallable("network", "getNeighborhood"); netGetNetAttrib_ptr = (SEXP (*)(SEXP, const char*)) R_GetCCallable("network", "getNetworkAttribute"); netHasLoops_ptr = (int (*)(SEXP)) R_GetCCallable("network", "hasLoops"); netIsAdj_ptr = (int (*)(SEXP, int, int, int)) R_GetCCallable("network", "isAdjacent"); netIsDir_ptr = (int (*)(SEXP)) R_GetCCallable("network", "isDirected"); netIsHyper_ptr = (int (*)(SEXP)) R_GetCCallable("network", "isHyper"); netIsLoop_ptr = (int (*)(SEXP, SEXP)) R_GetCCallable("network", "isLoop"); netIsMulti_ptr = (int (*)(SEXP)) R_GetCCallable("network", "isMultiplex"); netIsNetwork_ptr = (int (*)(SEXP)) R_GetCCallable("network", "isNetwork"); netNetEdgecount_ptr = (int (*)(SEXP, int)) R_GetCCallable("network", "networkEdgecount"); netNetSize_ptr = (int (*)(SEXP)) R_GetCCallable("network", "networkSize"); /*Register modification routines*/ netAddEdge_ptr = (SEXP (*)(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP)) R_GetCCallable("network", "addEdge_R"); netAddEdges_ptr = (SEXP (*)(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP)) R_GetCCallable("network", "addEdges_R"); netDelEdgeAttrib_ptr = (SEXP (*)(SEXP, int, const char*)) R_GetCCallable("network", "deleteEdgeAttribute"); netDelVertexAttrib_ptr = (SEXP (*)(SEXP, int, const char*)) R_GetCCallable("network", "deleteVertexAttribute"); netDelNetAttrib_ptr = (SEXP (*)(SEXP, const char*)) R_GetCCallable("network", "deleteNetworkAttribute"); netSetNetAttrib_ptr = (SEXP (*)(SEXP, const char*, SEXP)) R_GetCCallable("network", "setNetworkAttribute"); netSetVertexAttrib_ptr = (SEXP (*)(SEXP, const char*, SEXP, int)) R_GetCCallable("network", "setVertexAttribute"); } #endif network/inst/CITATION0000644000176200001440000000454314060054371014063 0ustar liggesusers# use the generic statnet header text #' statnet: statnet.cite.head('network') # ---- BEGIN AUTOGENERATED STATNET CITATION ---- citHeader(paste0(sQuote("network"), " is part of the Statnet suite of packages. ", "If you are using the ", sQuote("network"), " package for research that will be published, ", "we request that you acknowledge this by citing the following.\n", "For BibTeX format, use toBibtex(citation(\"", "network", "\")).")) # ---- END AUTOGENERATED STATNET CITATION ---- # generate the standard statnet-style package software manual citation #' statnet: statnet.cite.pkg('network') # ---- BEGIN AUTOGENERATED STATNET CITATION ---- bibentry("Manual", author = structure(list(list(given = "Carter T.", family = "Butts", role = c("aut", "cre"), email = "buttsc@uci.edu", comment = NULL)), class = "person"), title = paste("network", ": ", "Classes for Relational Data", sep = ""), organization = paste("The Statnet Project (\\url{", "http://www.statnet.org", "})", sep = ""), year = substr("2015-08-31", 1, 4), note = paste("R package version ", "1.13.0.1", sep = ""), url = paste("https://CRAN.R-project.org/package=", "network", sep = "")) # ---- END AUTOGENERATED STATNET CITATION ---- # generate an additional citation for Carter's original paper bibentry("Article", title = "network: a Package for Managing Relational Data in R.", author = person("Carter T.", "Butts", email = "buttsc@uci.edu"), journal = "Journal of Statistical Software", year = 2008, volume = 24, number = 2, url ="https://www.jstatsoft.org/v24/i02/paper") # add a network-specific footer citFooter("Some additional information regarding the C-level network API can be found in the README file within the network.api subdirectory under the package \"inst\" directory -- check your installed library tree.") # add the general statnet footer #' statnet: statnet.cite.foot('network') # ---- 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("network"), " is distributed under the terms of the license ", "GPL (>= 2)", ".")) # ---- END AUTOGENERATED STATNET CITATION ----