graph/0000755000175000017500000000000014147407454011517 5ustar nileshnileshgraph/DESCRIPTION0000644000175000017500000000234414136072220013213 0ustar nileshnileshPackage: graph Title: graph: A package to handle graph data structures Version: 1.72.0 Author: R. Gentleman, Elizabeth Whalen, W. Huber, S. Falcon Description: A package that implements some simple graph handling capabilities. Maintainer: Bioconductor Package Maintainer License: Artistic-2.0 Depends: R (>= 2.10), methods, BiocGenerics (>= 0.13.11) Imports: stats, stats4, utils Suggests: SparseM (>= 0.36), XML, RBGL, RUnit, cluster Enhances: Rgraphviz Collate: AllClasses.R AllGenerics.R bitarray.R buildDepGraph.R methods-graph.R graphNEL.R clustergraph.R NELhandler.R edgefunctions.R graphfunctions.R GXLformals.R gxlReader.R random.R write.tlp.R mat2graph.R settings.R zzz.R standardLabeling.R TODOT.R toDotWithRI.R methods-graphAM.R attrData.R reverseEdgeDirections.R nodes-methods.R methods-multiGraph.R MultiGraph.R methods-graphBAM.R graph-constructors.R LazyLoad: yes Packaged: 2021-10-26 21:35:12 UTC; biocbuild biocViews: GraphAndNetwork RoxygenNote: 7.1.1 git_url: https://git.bioconductor.org/packages/graph git_branch: RELEASE_3_14 git_last_commit: 7afbd26 git_last_commit_date: 2021-10-26 Date/Publication: 2021-10-26 NeedsCompilation: yes graph/man/0000755000175000017500000000000014136046755012273 5ustar nileshnileshgraph/man/pancrCaIni.Rd0000644000175000017500000000153114136046755014571 0ustar nileshnilesh\name{pancrCaIni} \alias{pancrCaIni} \non_function{} \title{ A graph encoding parts of the pancreatic cancer initiation pathway } \description{ A graph encoding parts of the pancreatic cancer initiation pathway } \usage{data(pancrCaIni)} \format{ The format is: Formal class 'graphNEL' [package "graph"] with edgemode "directed". } \source{ The KEGG pancreatic cancer pathway was visually inspected on 17 Sept 2007 and a subgraph was isolated. The HUGO names for each symbol in the KEGG visualization were obtained and checked for existance on hgu95av2. Some abbreviated terms for processes are also included as nodes. } %\references{ % %} \examples{ data(pancrCaIni) if (require(Rgraphviz)) { nat = rep(FALSE, length(nodes(pancrCaIni))) names(nat) = nodes(pancrCaIni) plot(pancrCaIni, nodeAttrs=list(fixedsize=nat)) } } \keyword{models} graph/man/leaves.Rd0000644000175000017500000000174414136046755014047 0ustar nileshnilesh\name{leaves} \alias{leaves} \alias{leaves,graph-method} \title{Find the leaves of a graph} \description{ A leaf of an undirected graph is a node with degree equal to one. A leaf of a directed graph is defined with respect to in-degree or out-degree. The leaves of a directed graph with respect to in-degree (out-degree) are those nodes with in-degree (out-degree) equal to zero. } \usage{ leaves(object, degree.dir) } \arguments{ \item{object}{A \code{graph} object} \item{degree.dir}{One of \code{"in"} or \code{"out"}. This argument is ignored when \code{object} is undirected and required otherwise. When \code{degree.dir="in"} (\code{degree.dir="out"}), nodes have no in coming (out going) edges will be returned. } } \value{ A character vector giving the node labels of the leaves. } \author{Seth Falcon} \examples{ data(graphExamples) graphExamples[[1]] leaves(graphExamples[[1]]) data(apopGraph) leaves(apopGraph, "in") leaves(apopGraph, "out") } graph/man/subGraph.Rd0000644000175000017500000000224714136046755014342 0ustar nileshnilesh\name{subGraph} \alias{subGraph} \alias{subGraph,character,graphNEL-method} \alias{subGraph,character,clusterGraph-method} \alias{subGraph,character,distGraph-method} \alias{subGraph,character,MultiGraph-method} \alias{subGraph,character,graphBAM-method} \title{Create a Subgraph } \description{ Given a set of nodes and a graph this function creates and returns subgraph with only the supplied nodes and any edges between them. } \usage{ subGraph(snodes, graph) } \arguments{ \item{snodes}{A \code{character} vector of node labels. } \item{graph}{A graph object, it must inherit from the \code{graph} class. } } \details{ The returned subgraph is a copy of the graph. Implementations for Implementations for \code{graphNEL}, \code{distGraph} and \code{clusterGraph}. } \value{ A graph of the same class as the \code{graph} argument but with only the supplied nodes. } \author{R. Gentleman } \seealso{ \code{\link{nodes}},\code{\link{edges}} } \examples{ set.seed(123) x <- rnorm(26) names(x) <- letters library(stats) d1 <- dist(x) g1 <- new("distGraph", Dist=d1) subGraph(letters[1:5], g1) } \keyword{manip} graph/man/validGraph.Rd0000644000175000017500000000142214136046755014642 0ustar nileshnilesh\name{validGraph} \alias{validGraph} \title{ Test whether graph object is valid } \description{ validGraph is a validating function for a graph object. } \usage{ validGraph(object, quietly=FALSE) } \arguments{ \item{object}{ a graph object to be tested } \item{quietly}{ \code{TRUE} or \code{FALSE} indicating whether output should be printed.} } \value{ If the graph object is valid, \code{TRUE} is returned otherwise \code{FALSE} is returned. If \code{object} is not a valid graph and \code{quietly} is set to \code{FALSE} then descriptions of the problems are printed. } \author{ Elizabeth Whalen } \seealso{\code{\link{graph-class}} } \examples{ testGraph<-graphNEL() testGraph@nodes<-c("node1","node2","node3") validGraph(testGraph) } \keyword{ manip} graph/man/toDotR-methods.Rd0000644000175000017500000000620214136046755015436 0ustar nileshnilesh\name{toDotR-methods} \docType{methods} \alias{toDotR} \alias{toDotR,graphNEL,character,list,list-method} \alias{toDotR,graphNEL,character,missing,missing-method} \alias{toDotR,graphNEL,character,missing,list-method} \alias{toDotR,graphNEL,missing,missing,missing-method} \alias{toDotR,graphNEL,missing,missing,list-method} \alias{toDotR,graphNEL,missing,character,missing-method} \alias{toDotR,graphNEL,missing,list,list-method} \alias{toDotR,graphNEL,missing,list,missing-method} %\S4method{toDotR,graphNEL,character,list,list-method} %\S4method{toDotR,graphNEL,character,missing,missing-method} %\S4method{toDotR,graphNEL,character,missing,list-method} %\S4method{toDotR,graphNEL,missing,missing,missing-method} %\S4method{toDotR,graphNEL,missing,missing,list-method} %\S4method{toDotR,graphNEL,missing,character,missing-method} %\S4method{toDotR,graphNEL,missing,list,list-method} %\S4method{toDotR,graphNEL,missing,list,missing-method} \title{ Methods for Function toDotR, using R to generate a dot serialization} \description{There are two basic methods of generating dot (\url{http://www.graphviz.org}) language serializations of R \code{\link{graph-class}} structures. First, using the \code{\link[Rgraphviz:toDot-methods]{toDot}} methods of the Rgraphviz package, the native graphviz agraph-associated methods can be employed to create the dot serialization. Second, with the methods described here, R functions can be used to perform the serialization directly from the graph data structure, without Rgraphviz.} \section{Methods}{\describe{ \item{G = "graphNEL", outDotFile = "character", renderList = "list", optList = "list"}{ create dot language descriptionof graph } \item{G = "graphNEL", outDotFile = "character", renderList = "missing", optList = "missing"}{ create dot language descriptionof graph } \item{G = "graphNEL", outDotFile = "character", renderList = "missing", optList = "list"}{ create dot language descriptionof graph } \item{G = "graphNEL", outDotFile = "missing", renderList = "missing", optList = "missing"}{ create dot language descriptionof graph } \item{G = "graphNEL", outDotFile = "missing", renderList = "missing", optList = "list"}{ create dot language descriptionof graph } \item{G = "graphNEL", outDotFile = "missing", renderList = "character", optList = "missing"}{ create dot language descriptionof graph } \item{G = "graphNEL", outDotFile = "missing", renderList = "list", optList = "list"}{ create dot language descriptionof graph } \item{G = "graphNEL", outDotFile = "missing", renderList = "list", optList = "missing"}{ create dot language descriptionof graph } \item{G = "compoundGraph", outDotFile = "character", renderList = "list", optList = "missing"}{ create dot language descriptionof graph } \item{G = "compoundGraph", outDotFile = "character", renderList = "list", optList = "list"}{ create dot language descriptionof graph } \item{G = "compoundGraph", outDotFile = "missing", renderList = "list", optList = "missing"}{ create dot language descriptionof graph } }} \seealso{\code{\link[Rgraphviz]{toDot-methods}}} \examples{ example(randomGraph) tmp <- tempfile() toDotR( g1, tmp ) readLines(tmp) unlink(tmp) } \keyword{methods} graph/man/defunct.Rd0000644000175000017500000000061514136046755014214 0ustar nileshnilesh\name{graph-defunct} \alias{graph-defunct} \title{Defunct Functions in Package \pkg{graph}} %------ PLEASE: put \alias{.} here for EACH ! \alias{pkgInstOrder} \alias{buildRepDepGraph} \alias{ugraphOld} % \description{ The functions or variables listed here are no longer part of the graph package. } \usage{ buildRepDepGraph() pkgInstOrder() ugraphOld() } \seealso{ \code{\link{Defunct}} } graph/man/mostEdges.Rd0000644000175000017500000000145014136046755014514 0ustar nileshnilesh\name{mostEdges} \alias{mostEdges} \title{ Find the node in a graph with the greatest number of edges } \description{ \code{mostEdges} finds the node that has the most edges in the graph. This is the node with the highest degree. } \usage{ mostEdges(objGraph) } \arguments{ \item{objGraph}{ the graph object } } \value{ \item{index}{the index of the node with the most edges} \item{id}{the node value with the most edges; may be affy id, locus link id, or genename depending on the node type} \item{maxLen}{the number of edges for that node} } \author{ Elizabeth Whalen } \seealso{ \code{\link{numEdges}}, \code{\link{aveNumEdges}}, \code{\link{numNoEdges}} } \examples{ set.seed(123) g1 <- randomGraph(11:30, letters[20:26], p=.4) mostEdges(g1) } \keyword{ manip } graph/man/removeNode.Rd0000644000175000017500000000220614136046755014665 0ustar nileshnilesh\name{removeNode} \alias{removeNode} \title{ removeNode } \description{ A function to remove a node from a graph. All edges to and from the node are also removed. } \usage{ removeNode(node, object) } \arguments{ \item{node}{The label of the node to be removed. } \item{object}{The graph to remove the node from. } } \details{ The specified node is removed from the graph as are all edges to and from that node. A new instance of the same class as \code{object} with the specified node(s) is returned. Note, node can be a vector of labels, in which case all nodes are removed. This is similar to \code{\link{subGraph}}. } \value{ A new instance of a graph of the same class as \code{object} but with all specified nodes removed. } \author{R. Gentleman} \seealso{\code{\link{removeEdge}}, \code{\link{addEdge}}, \code{\link{addNode}},\code{\link{subGraph}} } \examples{ V <- LETTERS[1:4] edL2 <- vector("list", length=4) names(edL2) <- V for(i in 1:4) edL2[[i]] <- list(edges=c(2,1,2,1)[i], weights=sqrt(i)) gR2 <- graphNEL(nodes=V, edgeL=edL2, edgemode="directed") gX <- removeNode("C", gR2) } \keyword{manip} graph/man/apoptosisGraph.Rd0000644000175000017500000000270314136046755015567 0ustar nileshnilesh\name{apoptosisGraph} \alias{apopGraph} \alias{apopAttrs} \alias{apopLocusLink} \docType{data} \title{KEGG apoptosis pathway graph} \description{ A graph representing the apoptosis pathway from KEGG, as well as a data.frame of attributes for use in plotting the graph with \code{Rgraphviz} and a list to compare the nodes with their respective LocusLink IDs. } \usage{ data(apopGraph) } \details{ The \code{apopGraph} data set contains three objects: The first is \code{apopGraph}, which is an object of class \code{graph-NEL} and represents the hsa04210 graph from \code{KEGG}. The second is \code{apopAttrs}, which is a data.frame with two columns, and a row for every node in \code{apopGraph}. The first column lists what color the node is represented with on the \code{KEGG} site. The second column lists the type of the node - either \code{genesym} or \code{text}. Most nodes are of type \code{genesym} as they represent genes, but some of the nodes in the \code{KEGG} graph were not genes and thus those nodes are of type \code{text}. The third, \code{apopLocusLink} is a named list where the names correspond to the node names in \code{apopGraph}. The values of the list are the LocusLink IDs that correspond to that node in the KEGG graph. } \source{ \url{http://www.genome.ad.jp/kegg/pathway/hsa/hsa04210.html} } \examples{ data(apopGraph) if (require("Rgraphviz") & interactive()) plot(apopGraph) } \keyword{datasets} graph/man/nodeDataDefaults-methods.Rd0000644000175000017500000000155114136046755017434 0ustar nileshnilesh\name{nodeDataDefaults-methods} \docType{methods} \alias{nodeDataDefaults-methods} \alias{nodeDataDefaults<--methods} \alias{nodeDataDefaults} \alias{nodeDataDefaults<-} \title{Get and set default attributes for the nodes of a graph} \usage{ nodeDataDefaults(self, attr) nodeDataDefaults(self, attr) <- value } \arguments{ \item{self}{A \code{graph-class} instance} \item{attr}{A \code{character} vector of length one giving the name of an attribute} \item{value}{An R object to set as the default value for the given attribute} } \description{ You can associate arbitrary attributes with the nodes of a graph. Use \code{nodeDataDefaults} to specify the set of attributes that describe nodes. Each attribute must have a default value. You can set the attribute for a particular node or set of nodes using \code{\link{nodeData}}. } \keyword{methods} graph/man/graphNEL-class.Rd0000644000175000017500000001447314136046755015336 0ustar nileshnilesh\name{graphNEL-class} \docType{class} \alias{graphNEL-class} \alias{graphNEL} \alias{coerce} \alias{edgeL} \alias{edges} \alias{initialize} \alias{nodes<-} \alias{nodes} \alias{addEdge,character,character,graphNEL,numeric-method} \alias{addEdge,character,character,graphNEL,missing-method} \alias{addNode,character,graphNEL-method} \alias{adj,graphNEL,ANY-method} \alias{clearNode,character,graphNEL-method} \alias{coerce,graphNEL,generalGraph-method} \alias{coerce,graphNEL,graphAM-method} \alias{coerce,graphNEL,graphBAM-method} \alias{edgeL,graphNEL-method} \alias{edges,graphNEL-method} \alias{edgeWeights,graphNEL-method} \alias{inEdges,graphNEL,missing-method} \alias{inEdges,missing,graphNEL-method} \alias{inEdges,character,graphNEL-method} \alias{initialize,graphNEL-method} \alias{nodes<-,graphNEL,character-method} \alias{nodes,graphNEL-method} \alias{numNodes,graphNEL-method} \alias{removeEdge,character,character,graphNEL-method} \alias{removeNode,character,graphNEL-method} \alias{toGXL,graphNEL-method} \title{Class "graphNEL"} \description{ This is a class of graphs that are represented in terms of nodes and an edge list. This is a suitable representation for a graph with a large number of nodes and relatively few edges. } \section{Slots}{ \describe{ \item{\code{nodes}:}{Object of class \code{"vector"}.} \item{\code{edgeL}:}{Object of class \code{"list"}. The \code{edgeL} must be the same length as \code{nodes}. The elements of this vector correspond to the same element in \code{nodes}. The elements are themselves lists. If the node has any edges then this list will have an element named \code{edges}. This will eventually change. Since edge weights are now stored in the edge attributes construct, we do not need the extra level of list. } } } \section{Extends}{ Class \code{"graph"}, directly. } \section{Constructor}{ \code{graphNEL(nodes=character(), edgeL=list(), edgemode='undirected')} creates a graphNEL instance. \describe{ \item{nodes}{A character vector of node labels.} \item{edgeL}{A named list either in the format returned by the \code{edges} method or a list of lists where each inner list has an element named \code{edges} and optionally an element named \code{weights}. If \code{weights} is present, it must be the same length as the \code{edges} element.} \item{edgemode}{Either "directed" or "undirected".} } } \section{Methods}{ \describe{ \item{adj}{\code{signature(object = "graphNEL")}: A method for finding nodes adjacent to the suplied node.} \item{edgeL}{\code{signature(graph = "graphNEL")}: A method for obtaining the edge list.} \item{edgeWeights}{\code{signature(object = "graphNEL")}: A method for obtaining the edge weights. } \item{edges}{\code{signature(object = "graphNEL")}: A method for obtaining the edges.} \item{inEdges}{\code{signature(node = "character", object = "graphNEL")}: Return the incoming edges for the specified nodes. See \code{\link{inEdges}}.} \item{nodes}{\code{signature(object = "graphNEL")}: A method for obtaining the nodes. } \item{numNodes}{\code{signature(object = "graphNEL")}:A method for determining how many nodes are in the graph. } \item{subGraph}{\code{signature(snodes="character", graph = "graphNEL")}:A method for obtaining the induced subgraph based on the set of supplied nodes and the supplied graph.} \item{plot}{Please see the help page for \code{plot.graphNEL} in the \code{Rgraphviz} package} \item{graph2graphviz}{\code{signature(object = "graphNEL")}: A method that will convert a \code{graphNEL} object into a matrix suitable for interaction with \code{Rgraphviz}. Not intended to be called directly. This function will insure that no NA's (or other undesired values) are in the graph, or created by coersion.} \item{nodes<-}{\code{signature(object="graphNEL", value="character")}: A method for replacing the nodes in a graph object. It checks to be sure the values are the right length and unique. } \item{coerce}{\code{signature(from = "graphNEL", to = "graphAM")}: Called via \code{as}, the method converts to an adjacency matrix representation. See \code{\link{graphAM-class}}. } \item{coerce}{\code{signature(from = "graphNEL", to = "graphBAM")}: Called via \code{as}, the method converts to an bit array representation. See \code{\link{graphBAM-class}}. } } } \details{ The \code{graphNEL} class provides a very general structure for representing graphs. It will be reasonably efficient for lists with relatively more nodes than edges. Although this representation can support multi-edges, such support is not implemented and instances of \code{graphNEL} are assumed to be simple graphs with at most one edge between any pair of nodes. The \code{edgeL} is a named \code{list} of the same length as the node vector. The names are the names of the nodes. Each element of \code{edgeL} is itself a list. Each element of this (sub)list is a vector (all must be the same length) and each element represents an edge to another node. The sublist named \code{edges} holds index values into the node vector. And each such entry represents an edge from the node which has the same name as the component of \code{edgeL} to the node with index provided. Another component that is often used is named \code{weights}. It represents edge weights. The user can specify any other edge attributes (such as types etc). They are responsible for any special handling that these might require. For an \code{undirected} instance all edges are reciprocated (there is an edge from A to B and from B to A). Note that the reason for using indices to represent the \code{to} end of a node is so that we can easily support permutation of the node labels as a way to generate randomizations of the graph. } \author{R. Gentleman} \seealso{\code{\link{graphAM-class}}, \code{\link{distGraph-class}}, \code{\link{clusterGraph-class}} } \examples{ set.seed(123) V <- LETTERS[1:4] edL <- vector("list", length=4) names(edL) <- V for(i in 1:4) edL[[i]] <- list(edges=5-i, weights=runif(1)) gR <- graphNEL(nodes=V, edgeL=edL) edges(gR) edgeWeights(gR) } \keyword{classes} graph/man/randomNodeGraph.Rd0000644000175000017500000000216514136046755015636 0ustar nileshnilesh\name{randomNodeGraph} \alias{randomNodeGraph} \title{Generate Random Graph with Specified Degree Distribution} \description{ \code{randomNodeGraph} generates a random graph with the specified degree distribution. Self-loops are allowed. The resultant graph is directed (but can always be coerced to be undirected). } \usage{ randomNodeGraph(nodeDegree) } \arguments{ \item{nodeDegree}{A named integer vector specifying the node degrees. } } \details{ The input vector must be named, the names are taken to be the names of the nodes. The sum must be even (there is a theorem that says we require that to construct a graph). Self-loops are allowed, although patches to the code that make this a switchable parameter would be welcome. } \value{ An instance of the \code{graphNEL} class. The graph is directed. } \references{Random Graphs as Models of Networks, M. E. J. Newman. } \author{R. Gentleman} \seealso{\code{\link{randomGraph}}, \code{\link{randomEGraph}} } \examples{ set.seed(123) c1 <- c(a = 1, b = 1, c = 2, d = 4) (g1 <- randomNodeGraph(c1)) stopifnot(validObject(g1)) } \keyword{graphs} \keyword{manip} graph/man/calcProb.Rd0000644000175000017500000000136614136046755014315 0ustar nileshnilesh\name{calcProb} \alias{calcProb} \title{ Calculate the hypergeometric probability of the subgraph's number of edges. } \description{ \code{calcProb} calculates the probability of having the number of edges found in the subgraph given that it was made from \code{origgraph}. The hypergeometric distribution is used to calculate the probability (using the pdf). } \usage{ calcProb(subgraph, origgraph) } \arguments{ \item{subgraph}{ subgraph made from the original graph } \item{origgraph}{ original graph object from which the subgraph was made } } \value{ The probability of the subgraph's number of edges is returned. } \author{ Elizabeth Whalen } \seealso{ \code{\link{calcSumProb}} } \examples{ #none right now } \keyword{ manip } graph/man/isDirected-methods.Rd0000644000175000017500000000071014136046755016300 0ustar nileshnilesh\name{isDirected-methods} \docType{methods} \alias{isDirected-methods} \alias{isDirected} \title{Determine if a graph has directed or undirected edges} \usage{ isDirected(object) } \arguments{ \item{object}{A \code{graph-class} instance} } \description{ The edges of a \code{\link{graph-class}} object are either directed or undirected. This function returns \code{TRUE} if the edges are directed and \code{FALSE} otherwise. } \keyword{methods} graph/man/settings.Rd0000644000175000017500000000221114136046755014416 0ustar nileshnilesh\name{graph.par} \alias{graph.par} \alias{graph.par.get} \title{Graphical parameters and other settings } \description{ Functions providing an interface to persistent graphical parameters and other settings used in the package. } \usage{ graph.par(...) graph.par.get(name) } \arguments{ \item{\dots}{ either character strings naming parameters whose values are to be retrieved, or named arguments giving values that are to be set. } \item{name}{ character string, giving a valid parameter name. } } \details{ \code{graph.par} works sort of like \code{\link{par}}, but the details are yet to be decided. \code{graph.par.get(name)} is equivalent to \code{graph.par(name)[[1]]} } \value{ In query mode, when no parameters are being set, \code{graph.par} returns a list containing the current values of the requested parameters. When called with no arguments, it returns a list with all parameters. When a parameter is set, the return value is a list containing previous values of these parameters. } \seealso{ \code{\link{par}} } \author{ Deepayan Sarkar, \email{deepayan.sarkar@r-project.org} } \keyword{utilities} graph/man/edgeMatrix.Rd0000644000175000017500000000522214136046755014654 0ustar nileshnilesh\name{edgeMatrix} \alias{edgeMatrix} \alias{eWV} \alias{pathWeights} \alias{edgeMatrix,graphNEL-method} \alias{edgeMatrix,graphAM-method} \alias{edgeMatrix,clusterGraph-method} \alias{edgeMatrix,distGraph-method} \alias{edgeMatrix,graphBAM-method} \title{Compute an Edge Matrix or weight vector for a Graph } \description{ For our purposes an \emph{edge matrix} is a matrix with two rows and as many columns as there are edges. The entries in the first row are the index of the node the edge is \emph{from}, those in the second row indicate the node the edge is \emph{to}. If the graph is \dQuote{undirected} then the \code{duplicates} option can be used to indicate whether reciprocal edges are wanted. The default is to leave them out. In this case the notions of \emph{from} and \emph{to} are not relevant. } \usage{ edgeMatrix(object, duplicates=FALSE) eWV(g, eM, sep = ifelse(edgemode(g) == "directed", "->", "--"), useNNames=FALSE) pathWeights(g, p, eM=NULL) } \arguments{ \item{object}{An object that inherits from \code{graph}. } \item{g}{An object that inherits from \code{graph}. } \item{duplicates}{Whether or not duplicate edges should be produced for \dQuote{undirected} graphs. } \item{eM}{An edge matrix} \item{sep}{a character string to concatenate node labels in the edge label} \item{useNNames}{a logical; if TRUE, node names are used in the edge label; if FALSE, node indices are used} \item{p}{a vector of node names constituting a path in graph \code{g}} } \details{ Implementations for \code{graphNEL}, \code{clusterGraph} and \code{distGraph} are available. } \value{ \code{edgeMatrix} returns a matrix with two rows, \emph{from} and \emph{to}, and as many columns as there are edges. Entries indicate the index in the node vector that corresponds to the appropriate end of the edge. \code{eWV} uses the edge matrix to create an annotated vector of edge weights. \code{pathWeights} returns an annotated vector of edge weights for a specified path in a graph. } \note{A path through an undirected graph may have several representations as a named vector of edges. Thus in the example, when the weights for path b-a-i are requested, the result is the pair of weights for edges a--b and a--i, as these are the edge labels computed for graph g1.} \author{R. Gentleman } \seealso{ \code{\link{edges}} } \examples{ set.seed(123) g1 <- randomGraph(letters[1:10], 1:4, p=.3) edgeMatrix(g1) g2 <- new("clusterGraph", clusters=list(a=c(1,2,3), b=c(4,5,6))) em2 <- edgeMatrix(g2) eWV(g1, edgeMatrix(g1)) eWV(g1, edgeMatrix(g1), useNNames=TRUE) pathWeights(g1, c("b", "a", "i")) } \keyword{manip } graph/man/edgeDataDefaults-methods.Rd0000644000175000017500000000123314136046755017410 0ustar nileshnilesh\name{edgeDataDefaults-methods} \docType{methods} \alias{edgeDataDefaults-methods} \alias{edgeDataDefaults<--methods} \alias{edgeDataDefaults} \alias{edgeDataDefaults<-} \title{Get and set default attributes for the edges of a graph} \usage{ edgeDataDefaults(self, attr) edgeDataDefaults(self, attr) <- value } \arguments{ \item{self}{A \code{\link{graph-class}} instance} \item{attr}{A \code{character} vector of length one giving the name of the attribute} \item{value}{An R class to use as the default value for the specified attribute} } \description{ Set default values for attributes associated with the edges of a graph. } \keyword{methods} graph/man/addEdge.Rd0000644000175000017500000000275514136046755014110 0ustar nileshnilesh\name{addEdge} \alias{addEdge} \title{ addEdge } \description{ A function to add an edge to a graph. } \usage{ addEdge(from, to, graph, weights) } \arguments{ \item{from}{The node the edge starts at } \item{to}{The node the edge goes to. } \item{graph}{The graph that the edge is being added to. } \item{weights}{A vector of weights, one for each edge. } } \details{ Both \code{from} and \code{to} can be vectors. They need not be the same length (if not the standard rules for replicating the shorter one are used). Edges are added to the graph between the supplied nodes. The \code{weights} are given for each edge. The implementation is a bit too oriented towards the \code{graphNEL} class and will likely change in the next release to accomodate more general graph classes. If the graph is undirected then the edge is bidirectional (and only needs to be added once). For directed graphs the edge is directional. } \value{ A new instance of a graph object with the same class as \code{graph} but with the indicated edges added. } \author{R. Gentleman} \seealso{\code{\link{addNode}},\code{\link{removeEdge}}, \code{\link{removeNode}} } \examples{ V <- LETTERS[1:4] edL2 <- vector("list", length=4) names(edL2) <- V for(i in 1:4) edL2[[i]] <- list(edges=c(2,1,2,1)[i], weights=sqrt(i)) gR2 <- graphNEL(nodes=V, edgeL=edL2, edgemode="directed") gX <- addEdge("A", "C", gR2, 1) gR3 <- randomEGraph(letters[10:14], .4) gY <- addEdge("n", "l", gR3, 1) } \keyword{ manip } graph/man/randomGraph.Rd0000644000175000017500000000355214136046755015031 0ustar nileshnilesh\name{randomGraph} \alias{randomGraph} \title{ Random Graph } \description{ This function generates a random graph according to a model that involves a latent variable. The construction is to randomly assign members of the set \code{M} to the nodes, \code{V}. An edge is assigned between two elements of \code{V} when they both have the same element of \code{M} assigned to them. An object of class \code{graphNEL} is returned. } \usage{ randomGraph(V, M, p, weights=TRUE) } \arguments{ \item{V}{The nodes of the graph. } \item{M}{A set of values used to generate the graph. } \item{p}{A value between 0 and 1 that indicates the probability of selecting an element of \code{M}} \item{weights}{A logical indicating whether to use the number of shared elements of \code{M} as weights. } } \details{ The model is quite simple. To generate a graph, \code{G}, the user supplies the list of nodes, \code{V} and a set of values \code{M} which will be used to create the graph. For each node in \code{V} a logical vector with length equal to the length of \code{M} is generated. The probability of a \code{TRUE} at any position is determined by \code{p}. Once valus from \code{M} have been assigned to each node in \code{V} the result is processed into a graph. This is done by creating an edge between any two elements of \code{V} that share an element of \code{M} (as chosen by the selection process). The sizes of \code{V} and \code{M} and the values of \code{p} determine how dense the graph will be. } \value{ An object of class \code{\link{graphNEL-class}} is returned. } \author{R. Gentleman } \seealso{\code{\link{randomEGraph}}, \code{\link{randomNodeGraph}} } \examples{ set.seed(123) V <- letters[1:10] M <- 1:4 g1 <- randomGraph(V, M, 0.2) numEdges(g1) # 16, in this case edgeNames(g1)# " ~ " since undirected } \keyword{graphs} graph/man/randomEGraph.Rd0000644000175000017500000000253114136046755015132 0ustar nileshnilesh\name{randomEGraph} \alias{randomEGraph} \title{ Random Edge Graph } \description{ A function to create random graphs according to a random edge model. The user supplies the set of nodes for the graph as \code{V} and either a probability, \code{p}, that is used for each edge or the number of edges, \code{edges} they want to have in the resulting graph. } \usage{ randomEGraph(V, p, edges) } \arguments{ \item{V}{The nodes for the graph. } \item{p}{ The probability of an edge being selected. } \item{edges}{ The number of edges wanted. } } \details{ The user must specify the set of nodes and either a probability for edge selection or the number of edges wanted, but not both. Let \code{nV} denote the number of nodes. There are \code{choose(nV, 2)} edges in the complete graph. If \code{p} is specified then a biased coin (probability of heads being \code{p}) is tossed for each edge and if it is heads that edge is selected. If \code{edges} is specified then that many edges are sampled without replacement from the set of possible edges. } \value{ An object of class \code{\link{graphNEL-class}} that contains the nodes and edges. } \author{R. Gentleman } \seealso{\code{\link{randomGraph}}} \examples{ set.seed(123) V <- letters[14:22] g1 <- randomEGraph(V, .2) g2 <- randomEGraph(V, edges=30) } \keyword{ manip } graph/man/addNode.Rd0000644000175000017500000000342714136046755014126 0ustar nileshnilesh\name{addNode} \alias{addNode} \alias{addNode,character,graphNEL,missing-method} \alias{addNode,character,graphNEL,list-method} \alias{addNode,character,distGraph,list-method} \alias{addNode,character,graphBAM,missing-method} \title{ addNode } \description{ Add one or more nodes to a graph. } \usage{ addNode(node, object, edges) } \arguments{ \item{node}{A character vector of node names. } \item{object}{A \code{graph} } \item{edges}{A named list of edges.} } \details{ The supplied \code{node}s are added to the set of nodes of the \code{object}. If \code{edges} are provided then their must be the same number as there are \code{node}s and the must be in the same order. The elements of the \code{edges} list are vectors. They can be character vectors of node labels for nodes in \code{object} and if so then they are added with unit weights. If the vector is numeric then it must be named (with labels corresponding to nodes in the \code{object}) and the values are taken to be the edge weights. When the \code{object} is a \code{distGraph} then the \code{edges} must be supplied and they must contain appropriate distances for all nodes both those in \code{object} and those supplied. } \value{ A new graph of the same class as \code{object} with the supplied node added to the set of nodes. } \author{R. Gentleman } \seealso{\code{\link{removeNode}}, \code{\link{removeEdge}}, \code{\link{addEdge}}} \examples{ V <- LETTERS[1:4] edL1 <- vector("list", length=4) names(edL1) <- V for(i in 1:4) edL1[[i]] <- list(edges=c(2,1,4,3)[i], weights=sqrt(i)) gR <- graphNEL(nodes=V, edgeL=edL1) gX <- addNode("X", gR) set.seed(123) g1 <- randomGraph(letters[1:10], 1:4, p=.3) g2 <- addNode("z", g1, edges=list(c("a", "h", "g"))) } \keyword{ manip } graph/man/clusterGraph-class.Rd0000644000175000017500000000463614136046755016341 0ustar nileshnilesh\name{clusterGraph-class} \docType{class} \alias{clusterGraph-class} \alias{clusterGraph-class} \alias{adj,clusterGraph,ANY-method} \alias{coerce,clusterGraph,matrix-method} \alias{connComp,clusterGraph-method} \alias{edges,clusterGraph-method} \alias{edgeL,clusterGraph-method} \alias{edgeWeights,clusterGraph-method} \alias{edgeWeights,clusterGraph,ANY-method} \alias{nodes,clusterGraph-method} \alias{nodes<-,clusterGraph,character-method} \alias{numNodes,clusterGraph-method} \alias{show,clusterGraph-method} \title{Class "clusterGraph" } \description{ A cluster graph is a special sort of graph for clustered data. Each cluster forms a completely connected subgraph. Three are no edges between clusters.} \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("clusterGraph", ...)}. } \section{Slots}{ \describe{ \item{\code{clusters}:}{Object of class \code{"list"} a list of the labels of the elements, one element of the list for each cluster. } } } \section{Extends}{ Class \code{"graph"}, directly. } \section{Methods}{ \describe{ \item{connComp}{\code{signature(object = "clusterGraph")}: find the connected components; simply the clusters in this case. } \item{acc}{\code{signature(object = "clusterGraph")}: find the accessible nodes from the supplied node. } \item{adj}{\code{signature(object = "clusterGraph")}: find the adjacent nodes to the supplied node. } \item{nodes}{\code{signature(object = "clusterGraph")}: return the nodes. } \item{nodes<-}{\code{signature(object="clusterGraph", value="character")}: replace the node names with the new labels given in \code{value}.} \item{numNodes}{\code{signature(object = "clusterGraph")}: return the number of nodes. } \item{edgeWeights}{Return a list of edge weights in a list format similar to the \code{edges} method.} \item{edgeL}{\code{signature(graph = "clusterGraph")}: A method for obtaining the edge list.} \item{coerce}{\code{signature(from = "clusterGraph", to = "matrix")}: Convert the \code{clusterGraph} to an adjacency matrix. Currently, weights are ignored. The conversion assumes no self-loops.} } } \author{R. Gentleman} \seealso{ \code{\link{graph-class}}, \code{\link{distGraph-class}} } \examples{ cG1 <- new("clusterGraph", clusters=list(a=c(1,2,3), b=c(4,5,6))) cG1 acc(cG1, c("1", "2")) } \keyword{classes} graph/man/write.tlp.Rd0000644000175000017500000000101614136046755014510 0ustar nileshnilesh\name{write.tlp} \alias{write.tlp} \title{ Write a graph object in a file in the Tulip format} \description{ Write a graph object in a file in the Tulip format. } \usage{ write.tlp(graph, filename) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{graph}{a \code{graph} object} \item{filename}{ Name of the output file} } \details{ The Tulip format is used by the program Tulip. } \references{http://www.tulip-software.org/} \author{Laurent Gautier } \keyword{ manip } graph/man/edgeSets.Rd0000644000175000017500000000146114136046755014327 0ustar nileshnilesh\name{edgeSets} \alias{esetsFemale} \alias{esetsMale} \docType{data} \title{MultiGraph edgeSet data} \description{ C57BL/6J and C3H/HeJ mouse strains exhibit different cardiovascular and metabolic phenotypes on the hyperlipidemic apolipoprotein E (Apoe) null background. The interaction data for the genes from adipose, brain, liver and muscle tissue samples from male and female mice are included as a list of \code{data.frame}s. Each \code{data.frame} contains information for the \code{from-gene}, \code{to-gene} and the strength of interaction (\code{weight}) for each of the tissues studied. } \usage{ data(esetsFemale) data(esetsMale) } \source{ Sage Commons Repository \url{http://sagebase.org/commons/dataset1.php#UCLA1} } \examples{ data(esetsFemale) data(esetsMale) } \keyword{datasets} graph/man/simpleEdge-class.Rd0000644000175000017500000000216714136046755015751 0ustar nileshnilesh\name{simpleEdge-class} \docType{class} \alias{simpleEdge-class} \title{Class "simpleEdge".} \description{A simple class for representing edges in graphs.} \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("simpleEdge", ...)}. } \section{Slots}{ \describe{ \item{\code{edgeType}:}{Object of class \code{"character"}; the type of the edge.} \item{\code{weight}:}{Object of class \code{"numeric"}; the edge weight.} \item{\code{directed}:}{Object of class \code{"logical"}; is the edge directed. } \item{\code{bNode}:}{Object of class \code{"character"}; the beginning node. } \item{\code{eNode}:}{Object of class \code{"character"}; the ending node. } } } \section{Methods}{ No methods defined with class "simpleEdge" in the signature. } \author{R. Gentleman} \note{All slots are length one vectors (this is not currently checked for). If the edge is not directed there is no real meaning to the concepts of beginning node or ending node and these should not be interpreted as such. } \examples{ new("simpleEdge", bNode="A", eNode="D") } \keyword{classes} graph/man/standardLabeling.Rd0000644000175000017500000000251014136046755016016 0ustar nileshnilesh\name{Standard labeling of edges with integers} \alias{ftM2int} \alias{int2ftM} \title{Standard labeling of edges with integers} \description{ Functions to convert between from-to representation and standard labeling of the edges for undirected graphs with no self-loops. } \usage{ ftM2int(ft) int2ftM(i) } \arguments{ \item{i}{Numeric vector.} \item{ft}{Numeric nx2 or 2xn matrix.} } \details{A standard 1-based node labeling of a graph G=(V,E) is a one-to-one mapping between the integers from 1 to |V| and the nodes in V. A standard 1-based edge labeling of an undirected graph G=(V,E) with no self-loops is \emph{the} one-to-one mapping between the integers from 1 to |V| choose 2 = |V|*(|V|-1)/2 such that the edge labeled 1 is between nodes 2 and 1, the edge labeled 2 is between nodes 3 and 1, the edge labeled 3 is between nodes 3 and 2, and so on. } \value{ For \code{ftM2int}, a numeric vector of length n. For \code{int2ftM}, a \code{length(i) x 2} matrix. } \author{Wolfgang Huber} \examples{ nNodes <- 200 nEdges <- choose(nNodes, 2) i <- 1:nEdges ft <- int2ftM(i) ft[1:6,] stopifnot(all(ft[,1]>ft[,2])) ## always from higher to lower stopifnot(!any(duplicated(paste(ft[,1], ft[,2])))) stopifnot(ft[nEdges, 1]==nNodes, ft[nEdges, 2]==nNodes-1) j <- ftM2int(ft) stopifnot(all(i==j)) } \keyword{graphs} graph/man/nodeData-methods.Rd0000644000175000017500000000155614136046755015751 0ustar nileshnilesh\name{nodeData-methods} \docType{methods} \alias{nodeData-methods} \alias{nodeData<--methods} \alias{nodeData} \alias{nodeData<-} \title{Get and set attributes for the nodes of a graph object} \description{ Attributes of the nodes of a graph can be accessed using \code{nodeData}. The attributes must be defined using \code{\link{nodeDataDefaults}}. You can ommit the \code{n} argument to retrieve attributes for all nodes in the graph. You can ommit the \code{attr} argument to retrieve all attributes. } \usage{ nodeData(self, n, attr) nodeData(self, n, attr) <- value } \arguments{ \item{self}{A \code{graph-class} instance} \item{n}{A \code{character} vector of node names} \item{attr}{A \code{character} vector of length one specifying the name of a node attribute} \item{value}{An R object to store as the attribute value} } \keyword{methods} graph/man/inEdges.Rd0000644000175000017500000000216314136046755014142 0ustar nileshnilesh\name{inEdges} \alias{inEdges} \title{Generic Method inEdges} \description{ Returns a list of all incoming edges for the specified nodes. } \usage{ inEdges(node, object) } \arguments{ \item{node}{character vector of node names} \item{object}{a \code{graph} object} } \details{ If no \code{node} argument is specified, \code{inEdges} returns the incoming edges for all nodes in the graph. For an undirected graph, \code{inEdges} returns all edges for the specified nodes. } \value{ A list with length matching the length of \code{node}. If \code{node} was missing, a list containing an element for each node in the graph. Each list element contains a character vector of node names giving the nodes that have outgoing edges to the node given by the name of the list element. } \author{R. Gentleman} \seealso{\code{\link{removeNode}}, \code{\link{clearNode}}} \examples{ V <- LETTERS[1:4] edL3 <- vector("list", length=4) for(i in 1:4) edL3[[i]] <- list(edges=(i\%\%4)+1, weights=i) names(edL3) <- V gR3 <- graphNEL(nodes=V, edgeL=edL3, "directed") inEdges(c("A", "B"), gR3) } \keyword{ manip} graph/man/MultiGraph-class.Rd0000644000175000017500000002636314136046755015753 0ustar nileshnilesh\name{MultiGraph-class} \Rdversion{1.1} \docType{class} \alias{MultiGraph-class} \alias{nodes,MultiGraph-method} \alias{numEdges,MultiGraph-method} \alias{numEdges,MGEdgeSet-method} \alias{numNodes,MultiGraph-method} \alias{show,MultiGraph-method} \alias{MultiGraph} \alias{eweights} \alias{edgeSetIntersect0} \alias{edgeSetUnion0} \alias{subsetEdgeSets} \alias{extractFromTo} \alias{extractFromTo,MultiGraph-method} \alias{extractGraphAM} \alias{extractGraphBAM} \alias{isDirected,MultiGraph-method} \alias{ugraph,MultiGraph-method} % these are not supposed to be publicly available % but aliased here to quiet R CMD check \alias{isDirected,DiEdgeSet-method} \alias{isDirected,UEdgeSet-method} \alias{ugraph,DiEdgeSet-method} \alias{ugraph,UEdgeSet-method} \alias{graphIntersect,MultiGraph,MultiGraph-method} \alias{graphUnion,MultiGraph,MultiGraph-method} \alias{nodeData,MultiGraph,character,character-method} \alias{nodeData,MultiGraph,character,missing-method} \alias{nodeData,MultiGraph,missing,character-method} \alias{nodeData,MultiGraph,missing,missing-method} \alias{nodeData<-,MultiGraph,character,character-method} \alias{nodeData<-,MultiGraph,missing,character-method} \alias{mgEdgeDataDefaults} \alias{mgEdgeDataDefaults<-} \alias{mgEdgeDataDefaults,MultiGraph,character,character-method} \alias{mgEdgeDataDefaults,MultiGraph,character,missing-method} \alias{mgEdgeDataDefaults<-,MultiGraph,character,character,ANY-method} \alias{mgEdgeDataDefaults<-,MultiGraph,character,missing,list-method} \alias{nodeDataDefaults,MultiGraph,character-method} \alias{nodeDataDefaults,MultiGraph,missing-method} \alias{nodeDataDefaults<-,MultiGraph,character,ANY-method} \alias{nodeDataDefaults<-,MultiGraph,missing,list-method} \alias{mgEdgeData} \alias{mgEdgeData<-} \alias{mgEdgeData,MultiGraph,character,character,character,character-method} \alias{mgEdgeData,MultiGraph,character,character,missing,character-method} \alias{mgEdgeData,MultiGraph,character,missing,character,character-method} \alias{mgEdgeData,MultiGraph,character,missing,missing,character-method} \alias{mgEdgeData<-,MultiGraph,character,character,character,character-method} \alias{mgEdgeData<-,MultiGraph,character,character,missing,character-method} \alias{mgEdgeData<-,MultiGraph,character,missing,character,character-method} \alias{mgEdgeData<-,MultiGraph,character,missing,missing,character-method} \alias{edges,MultiGraph-method} \alias{edgeNames,MultiGraph-method} \alias{edgeSets} \alias{edgeSets,MultiGraph-method} \title{EXPERIMENTAL class "MultiGraph"} \description{ The MultiGraph class represents a single node set and a set of edge sets. Each edge set is either directed or undirected. We can think of an edge in a MultiGraph as a 4-tuple (from-node, to-node, edge-type, weight), where the edge-type field in the tuple identifies the edge set, the weight is a numeric value, and the order of the nodes only matters in the case of a directed edge set. Unlike some of the graph representations, self-loops are allowed (from-node == to-node). There is support for arbitrary edge attributes which is primarily useful for rendering plots of MultiGraphs. These attributes are stored separately from the edge weights to facilitate efficient edge weight computation. } \usage{ MultiGraph(edgeSets, nodes = NULL, directed = TRUE, ignore_dup_edges = FALSE) eweights(object, names.sep = NULL) edgeSetIntersect0(g, edgeFun = NULL) edgeSetIntersect0(g, edgeFun = NULL) extractGraphAM(g, edgeSets) extractGraphBAM(g, edgeSets) } \arguments{ \item{edgeSets}{ A named list of \code{data.frame} objects each representing an edge set of the multigraph. Each \code{data.frame} must have three columns: "from", "to", and "weight". Columns "from" and "to" can be either factors or character vectors. The "weight" column must be numeric. } \item{nodes}{ A character vector of node labels. Nodes with zero degree can be included in a graph by specifying the node labels in \code{nodes}. The node set of the resulting multigraph is the union of the node labels found in \code{edgeSets} and \code{nodes}. } \item{directed}{ A logical vector indicating whether the edge sets specified in \code{edgeSets} represent directed edges. If this argument has length one, the value applies to all edge sets in \code{edgeSets}. Otherwise, this argument must have the same length as \code{edgeSets}, values are aligned by position. } \item{object}{ A \code{MultiGraph} instance } \item{g}{ A \code{MultiGraph} instance } \item{names.sep}{ The string to use as a separator between from and to node labels. If \code{NULL} no names will be attached to the returned vector. } \item{ignore_dup_edges}{ If \code{FALSE} (default), specifying duplicate edges in the input is an error. When set to \code{TRUE} duplicate edges are ignored. Edge weight values are ignored when determining duplicates. This is most useful for graph import and conversion. } \item{edgeFun}{ A user specified named list of functions to resolve edge attributes in a union or intersection operation } } \section{Constructors}{ \code{MultiGraph} } \section{Methods}{ \describe{ \item{nodes}{Return the nodes of the multigraph.} \item{numEdges}{Return an integer vector named by edge set containing edge counts for each edge set.} \item{numNodes}{Return the number of nodes in the multigraph.} \item{eweights}{Return a list named by edge set; each element is a numeric vector of edge weights for the corresponding edge set.} \item{isDirected}{Return a logical vector named by the edge sets in \code{object} with a \code{TRUE} indicating a directed edge set and \code{FALSE} for undirected.} \item{edges}{Returns a list named by edge set; for the edges in the MultiGraph} \item{edgeNames}{Returns a list named by the edge set; for the names of the edges in the MultiGraph} \item{extractFromTo}{Return a list named by the edge sets; each element is a data frame with column names from, to and weight corresponding to the connected nodes in the edge set.} \item{subsetEdgeSets}{Return a new \code{MultiGraph} object representing the subset of edge sets from the original \code{MultiGraph}.} \item{extractGraphAM}{Return a named \code{list} of \code{graphAM} objects corresponding to the edge sets from the original \code{MultiGraph}.} \item{extractGraphBAM}{Return a named \code{list} of \code{graphBAM} objects corresponding to the edge sets from the original \code{MultiGraph}.} \item{ugraph}{Return a new \code{MultiGraph} object in which all edge sets have been converted to undirected edge sets. This operation sets all edge weights to one and drops other edge attributes.} \item{edgeSetIntersect0}{Return a new \code{MultiGraph} object representing the intersection of edges across all edge sets within \code{g}. The return value will have a single edge set if the edge sets in \code{g} are disjoint. Otherwise, there will be a single edge set containing the shared edges. The node set is preserved. Edge weights and edge attributes are transferred over to the output if they have the same value, else user has the option of providing a function to resolve the conflict.} \item{edgeSetUnion0}{Return a new \code{MultiGraph} object representing the union of edges across all edge sets within \code{g}. The node set is preserved. Edge weights and edge attributes are transferred over to the output if they have the same value, else user has the option of providing a function to resolve the conflict.} \item{\code{graphIntersect(x, y, nodeFun, edgeFun)}}{ When given two \code{MultiGraph} objects, \code{graphIntersect} returns a new \code{MultiGraph} containing the nodes and edges in common between the two graphs. The intersection is computed by first finding the intersection of the node sets, obtaining the induced subgraphs, and finding the intersection of the resulting edge sets. The corresponding named edgeSets in \code{x} and \code{y} should both be either directed or undirected.Node/Edge attributes that are equal are carried over to the result. Non equal edge/node attributes will result in the corresponding attribute being set to NA. The user has the option of providing a named list(names of edgeSets) of list (names of edge attributes) of edge functions correspoding to the names of the edge attributes for resolving conflicting edge attributes (\code{edgeFun}). For resolving any of the conflicting node attributes, the user has the option of providing a named \code{list} of functions corresponding to the node attribute names (\code{nodeFun}). } \item{\code{graphUnion(x, y, nodeFun, edgeFun)}}{ When given two \code{MultiGraph} objects, \code{graphUnion} returns a new \code{MultiGraph} containing the union of nodes and edges between the two graphs. The corresponding pairs of named edgeSets in \code{x} and \code{y} should both be either directed or undirected. Non equal edge/node attributes will result in the corresponding attribute being set to NA. The user has the option of providing a named list(names of edgeSets) of list (names of edge attributes) of edge functions correspoding to the names of the edge attributes for resolving conflicting edge attributes (\code{edgeFun}). For resolving any of the conflicting node attributes, the user has the option of providing a named \code{list} of functions corresponding to the node attribute names (\code{nodeFun}). } \item{ \code{edgeSets(object, ...)}}{ Returns the names of the edgeSets in the MultiGraph \code{object} as a character vector. } \item{show}{Prints a short summary of a MultiGraph object} } } \author{S. Falcon, Gopalakrishnan N} \examples{ ft1 <- data.frame(from=c("a", "a", "a", "b", "b"), to=c("b", "c", "d", "a", "d"), weight=c(1, 3.1, 5.4, 1, 2.2), stringsAsFactors = TRUE) ft2 <- data.frame(from=c("a", "a", "a", "x", "x", "c"), to=c("b", "c", "x", "y", "c", "a"), weight=c(3.4, 2.6, 1, 1, 1, 7.9), stringsAsFactors = TRUE) esets <- list(es1=ft1, es2=ft2) g <- MultiGraph(esets) nodes(g) numEdges(g) eweights(g) eweights(g, names.sep = "=>") isDirected(g) edges(g, edgeSet ="es1") edges(g, "a", "es1") edgeNames(g, "es2") edgeSets(g) ug <- ugraph(g) isDirected(ug) numEdges(ug) edgeSetIntersect0(g) subsetEdgeSets(g, "es1") extractFromTo(g) extractGraphAM(g) extractGraphAM(g, "es1") extractGraphBAM(g, "es1") graphIntersect(g, g) graphUnion(g,g) mgEdgeDataDefaults(g, "es1", attr = "color" ) <- "white" mgEdgeData(g, "es1", from = "a", to = c("b", "c"), attr = "color") <- "red" mgEdgeData(g, "es1", from = "a", to = c("b", "c"), attr = "color") nodeDataDefaults(g, attr ="shape") <- "circle" nodeData(g, n = c("a", "b", "c"), attr = "shape") <- "triangle" nodeData(g, n = c("a", "b", "x", "y"), attr = "shape") } \keyword{classes} graph/man/internal.Rd0000644000175000017500000000037014136046755014376 0ustar nileshnilesh\name{internal} \alias{nullgraphID} \title{Variables used for internal purposes} \description{ The \code{nullgraphID} variable is used to store a default identifier. This should not be used by users. } \author{Saikat DebRoy} \keyword{internal} graph/man/attrData-class.Rd0000644000175000017500000000566314136046755015443 0ustar nileshnilesh\name{attrData-class} \docType{class} \alias{attrData-class} \alias{attrDataItem<-,attrData,character,character-method} \alias{attrDataItem,attrData,character,missing-method} \alias{attrDataItem,attrData,character,character-method} \alias{attrDefaults<-,attrData,character,ANY-method} \alias{attrDefaults<-,attrData,missing,list-method} \alias{attrDefaults,attrData,missing-method} \alias{attrDefaults,attrData,character-method} \alias{initialize,attrData-method} \alias{names,attrData-method} \alias{names<-,attrData,character-method} \alias{removeAttrDataItem<-} \alias{removeAttrDataItem<-,attrData,character,NULL-method} \title{Class "attrData"} \description{A container class to manage generic attributes. Supports named attributes with default values with methods for vectorized access. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("attrData", defaults)}. The \code{defaults} argument should be a named list containing the initial attribute names and default values. } \section{Slots}{ \describe{ \item{\code{data}:}{Where custom attribute data is stored} \item{\code{defaults}:}{A named list of known attribute names and defualt values.} } } \section{Methods}{ \describe{ \item{attrDataItem<-}{\code{signature(self = "attrData", x = "character", attr = "character")}: ... } \item{attrDataItem}{\code{signature(self = "attrData", x = "character", attr = "missing")}: ... } \item{attrDataItem}{\code{signature(self = "attrData", x = "character", attr = "character")}: ... } \item{attrDefaults<-}{\code{signature(self = "attrData", attr = "character", value = "ANY")}: ... } \item{attrDefaults<-}{\code{signature(self = "attrData", attr = "missing", value = "list")}: ... } \item{attrDefaults}{\code{signature(self = "attrData", attr = "missing")}: ... } \item{attrDefaults}{\code{signature(self = "attrData", attr = "character")}: ... } \item{initialize}{\code{signature(.Object = "attrData")}: ... } \item{names}{return the names of the stored attributes} \item{names<-}{set the names of the stored attributes} \item{removeAttrDataItem}{\code{signature(self="attrData", x="character", value="NULL")}: Remove the data associated with the key specified by \code{x}.} } } \author{Seth Falcon} \examples{ defaultProps <- list(weight=1, color="blue", friends=c("Bob", "Alice")) adat <- new("attrData", defaults=defaultProps) ## Get all defaults attrDefaults(adat) ## Or get only a specific attribute attrDefaults(adat, attr="color") ## Update default weight attrDefaults(adat, attr="weight") <- 500 ## Add new attribute attrDefaults(adat, attr="length") <- 0 ## Asking for the attributes of an element you haven't customized ## returns the defaults attrDataItem(adat, x=c("n1", "n2"), attr="length") ## You can customize values attrDataItem(adat, x=c("n1", "n2"), attr="length") <- 5 ## What keys have been customized? names(adat) } \keyword{classes} graph/man/clearNode.Rd0000644000175000017500000000141114136046755014453 0ustar nileshnilesh\name{clearNode} \alias{clearNode} \title{ clearNode } \description{ This function removes all edges to or from the specified node in the graph. } \usage{ clearNode(node, object) } \arguments{ \item{node}{a node } \item{object}{a \code{graph} } } \details{ All edges to and from \code{node} are removed. \code{node} can be a vector. } \value{ A new instance of the graph with all edges to and from the specified node(s) removed. } \author{R. Gentleman} \seealso{\code{\link{removeNode}}, \code{\link{removeEdge}}} \examples{ V <- LETTERS[1:4] edL3 <- vector("list", length=4) for(i in 1:4) edL3[[i]] <- list(edges=(i\%\%4)+1, weights=i) names(edL3) <- V gR3 <- graphNEL(nodes=V, edgeL=edL3, "directed") g4 <- clearNode("A", gR3) } \keyword{manip } graph/man/edgeWeights.Rd0000644000175000017500000001034214136046755015021 0ustar nileshnilesh\name{edgeWeights} \alias{edgeWeights} \title{Retrieve the edge weights of a graph} \description{ A generic function that returns the edge weights of a graph. If \code{index} is specified, only the weights for the edges from the specified nodes are returned. The user can control which edge attribute is interpreted as the weight, see the Details section. } \usage{ edgeWeights(object, index, ..., attr = "weight", default = 1, type.checker = is.numeric) } \arguments{ \item{object}{A graph, any object that inherits from the \code{graph} class.} \item{index}{If supplied, a character or numeric vector of node names or indices.} \item{...}{Unused.} \item{attr}{The name of the edge attribute to use as a weight. You can view the list of defined edge attributes and their default values using \code{edgeDataDefaults}. The default attribute name is \code{"weight"}, see the Details section.} \item{default}{The value to use if \code{object} has no edge attribute named by the value of \code{attr}. The default is the value 1 (double).} \item{type.checker}{A function that will be used to check that the edge weights are of the correct type. This function should return TRUE if the input vector is of the right type and FALSE otherwise. The default is to check for numeric edge weights using \code{is.numeric}. If no type checking is desired, specify \code{NULL}.} } \details{ If \code{index} is suppled, then edge weights from these nodes to all adjacent nodes are returned. If \code{index} is not supplied, then the edge weights for all nodes are returned. The value for nodes without any outgoing edges will be a zero-length vector of the appropriate mode. The \code{edgeWeights} method is a convenience wrapper around \code{edgeData}, the general-purpose way to access edge attribute information for a \code{graph} instance. In general, edge attributes can be arbitary R objects. However, for \code{edgeWeights} to make sense, the values must be vectors of length not more than one. By default, \code{edgeWeights} looks for an edge attribute with name \code{"weight"} and, if found, uses these values to construct the edge weight list. You can make use of attributes stored under a different name by providing a value for the \code{attr} argument. For example, if \code{object} is a graph instance with an edge attribute named \code{"WTS"}, then the call \code{edgeWeights(object, attr="WTS")} will attempt to use those values. The function specified by \code{type.checker} will be given a vector of edge weights; if the return value is not \code{TRUE}, then an error will be signaled indicating that the edge weights in the graph are not of the expected type. Type checking is skipped if \code{type.checker} is \code{NULL}. If the graph instance does not have an edge attribute with name given by the value of the \code{attr} argument, \code{default} will be used as the weight for all edges. Note that if there is an attribute named by \code{attr}, then its default value will be used for edges not specifically customized. See \code{edgeData} and \code{edgeDataDefaults} for more information. Because of their position after the \code{...}, no partial matching is performed for the arguments \code{attr}, \code{default}, and \code{type.checker}. } \value{ A named list of named edge weight vectors. The names on the list are the names of the nodes specified by \code{index}, or all nodes if \code{index} was not provided. The names on the weight vectors are node names to identify the edge to which the weight belongs. } \author{R. Gentleman and S. Falcon} \seealso{ \code{\link{nodes}} \code{\link{edges}} \code{\link{edgeData}} \code{\link{edgeDataDefaults}} \code{\link{is.numeric}} \code{\link{is.integer}} \code{\link{is.character}} } \examples{ V <- LETTERS[1:4] edL2 <- vector("list", length=4) names(edL2) <- V for(i in 1:4) edL2[[i]] <- list(edges=c(2,1,2,1)[i], weights=sqrt(i)) gR2 <- graphNEL(nodes=V, edgeL=edL2, edgemode="directed") edgeWeights(gR2, "C") edgeWeights(gR2) edgeWeights(gR2, attr="foo", default=5) edgeData(gR2, attr="weight") edgeData(gR2, from="C", attr="weight") } \keyword{manip} graph/man/attrDefaults-methods.Rd0000644000175000017500000000172614136046755016673 0ustar nileshnilesh\name{attrDefaults-methods} \docType{methods} \alias{attrDefaults-methods} \alias{attrDefaults<--methods} \alias{attrDefaults} \alias{attrDefaults<-} \title{Get and set the default attributes of an attrData object} \usage{ attrDefaults(self, attr) attrDefaults(self, attr) <- value } \arguments{ \item{self}{A \code{\link{attrData-class}} instance} \item{attr}{A \code{character} vector of length 1 giving the name of an attribute. Can be missing.} \item{value}{An R object that will be used as the default value of the specified attribute, or a named list of attribute name/default value pairs if \code{attr} is missing.} } \description{ The \code{attrDefaults} method provides access to a \code{\link{attrData-class}} object's default attribute list. The default attribute list of a \code{attrData-class} object defines what attributes can be customized for individual data elements by defining attribute names and default values. } \keyword{methods} graph/man/duplicatedEdges.Rd0000644000175000017500000000153014136046755015647 0ustar nileshnilesh\name{duplicatedEdges} \alias{duplicatedEdges} \title{duplicatedEdges } \description{ A multigraph is a graph where edges between nodes can be represented several times. For some algorithms this causes problems. \code{duplicatedEdges} tests an instance of the \code{graphNEL} class to see if it has duplicated edges and returns \code{TRUE} if it does and \code{FALSE} otherwise. } \usage{ duplicatedEdges(graph) } \arguments{ \item{graph}{An instance of the class \code{graphNEL} } } \details{ It would be nice to handle other types of graphs. } \value{ A logical, either \code{TRUE} if the graph has duplicated edges or \code{FALSE} it not. } \author{R. Gentleman } \seealso{ \code{\link{connComp}}, \code{\link{ugraph}} } \examples{ ##---- Should be DIRECTLY executable !! ---- ##-- ==> Define data, use random, } \keyword{manip } graph/man/IMCA.Rd0000644000175000017500000000404514136046755013276 0ustar nileshnilesh\name{integrinMediatedCellAdhesion} \alias{IMCA} \alias{IMCAAttrs} \alias{IMCAGraph} \alias{integrinMediatedCellAdhesion} \docType{data} \title{KEGG Integrin Mediated Cell Adhesion graph} \description{ A graph representing the integrin-mediated cell adhesion pathway from KEGG, as well as a list of attributes for use in plotting the graph with \code{Rgraphviz}. } \usage{ data(integrinMediatedCellAdhesion) } \details{ The \code{integrinMediatedCellAdhesion} data set contains two objects: The first is \code{IMCAGraph}, which is an object of class \code{graph-NEL} and represents the hsa04510 graph from \code{KEGG}. The second is \code{IMCAAttrs}, which is a list of four elements. The first element, \code{defAttrs} corresponds to the \code{attrs} arguments of \code{\link[Rgraphviz]{agopen}} and \code{\link[Rgraphviz:plot-methods]{plot.graph}}. The second element is \code{nodeAttrs} which corresponds to the \code{nodeAttrs} argument in the same two functions from \code{Rgraphviz}. The third element, \code{subGList} corresponds to the \code{subGList} argument in those functions. Lastly, the fourth element, \code{LocusLink} provides a named list where the names are the nodes and the values are vectors of LocusLink ID values which correspond to those nodes. The values from \code{defAttrs}, \code{nodeAttrs} and \code{subGList} in the \code{IMCAAttrs} list are part of an ongoing attempt by Bioconductor to provide the set of options to most accurately recreate the actual visual image of the pathway from the KEGG site using \code{Rgraphviz}. Users may try out their own combination of attributes and settings for their own needs, but these represent our own efforts at as closely recreating the image as possible. } \source{ \url{http://www.genome.ad.jp/kegg/pathway/hsa/hsa04510.html} } \examples{ data(integrinMediatedCellAdhesion) if (require("Rgraphviz") & interactive()) plot(IMCAGraph, attrs=IMCAAttrs$defAttrs, nodeAttrs=IMCAAttrs$nodeAttrs, subGList=IMCAAttrs$subGList) } \keyword{datasets} graph/man/fromGXL-methods.Rd0000644000175000017500000000636614136046755015554 0ustar nileshnilesh\name{fromGXL-methods} \docType{methods} \title{ Methods for GXL manipulations in package graph } \alias{fromGXL-methods} \alias{toGXL-methods} \alias{GXL} \alias{dumpGXL-methods} \alias{dumpGXL} \alias{fromGXL} \alias{gxlTreeNEL} \alias{NELhandler} \alias{toGXL} \alias{validateGXL} \alias{dumpGXL,connection-method} \alias{fromGXL,connection-method} \alias{validateGXL,connection-method} \description{GXL \url{http://www.gupro.de/GXL} is "an XML sublanguage designed to be a standard exchange format for graphs". This document describes tools in the graph package for importing GXL data to R and for writing graph data out as GXL.} \value{ \item{fromGXL}{currently returns a graphNEL when possible. This function is based on \code{\link[XML]{xmlEventParse}} with handlers defined in the function NELhandler. The dump() element of this handler should emit information on all children of nodes and edges; the asGraphNEL() element will return a \code{\linkS4class{graphNEL}} object with weights if child \code{} with name attribute "weights" is present for each edge element.} \item{toGXL}{for an input of class "graphNEL", returns an object of class c("XMLInternalDOM", "XMLOutputStream"); see the example for how to convert this to a text stream encoding XML} \item{dumpGXL}{returns an R list with all the node, edge, and named attribute information specified in the GXL stream} \item{validateGXL}{returns silently (invisibly returns the parsed tree) for a DTD-compliant stream, or is otherwise very noisy} } \section{Methods}{ \describe{ \item{fromGXL}{ con = connection: returns a graphNEL based on a parsing of the GXL stream on the connection } \item{dumpGXL}{ con = connection: returns an R list based on a parsing of the GXL stream on the connection } \item{validateGXL}{ con = connection: checks the GXL stream against its DTD} \item{toGXL}{ object = graphNEL: creates an XMLInternalDOM representing the graph in GXL} } } \author{Vince Carey } \note{At present, toGXL does not return a validating GXL stream because XML package does not properly handle the dtd and namespaces arguments to xmlTree. This is being repaired. To fix the stream, add \code{ } as second record in the output. Some structures in a graphNEL and some tags in GXL may not be handled at this time. } \examples{ sf <- file(system.file("GXL/simpleExample.gxl", package="graph")) show(fromGXL(sf)) print(dumpGXL(sf)) close(sf) #validateGXL(sf) # bad <- file(system.file("GXL/c2.gxl", package="graph")) # here's how you can check if the GXL is well-formed, if # you have a libxml2-based version of R XML package # # try( validateGXL(bad) ) # gR <- graphNEL(nodes=letters[1:4], edgeL=list( a=list(edges=4), b=list(edges=3), c=list(edges=c(2,1)), d=list(edges=1)), edgemode="directed") # # following requires that you are using XML bound with recent libxml2 # #an <- as.numeric #if (an(libxmlVersion()$major)>=2 && an(libxmlVersion()$minor)>=4) ## since toGXL returns an XML object, we need to attach the XML ## package. library("XML") cat(saveXML(toGXL(gR)$value())) wtd <- file(system.file("GXL/kmstEx.gxl", package="graph")) wtdg <- fromGXL(wtd) close(wtd) print(edgeWeights(wtdg)) } \keyword{methods} \keyword{ models } graph/man/matrix2Graph.Rd0000644000175000017500000000772014136046755015140 0ustar nileshnilesh\name{Coercions between matrix and graph representations} \alias{aM2bpG} \alias{ftM2adjM} \alias{ftM2graphNEL} \alias{coerce,matrix,graphNEL-method} \alias{coerce,graphNEL,matrix-method} \title{Coercions between matrix and graph representations} \description{ A collection of functions and methods to convert various forms of matrices into graph objects. } \usage{ aM2bpG(aM) ftM2adjM(ft, W=NULL, V=NULL, edgemode="directed") ftM2graphNEL(ft, W=NULL, V=NULL, edgemode="directed") \S4method{coerce}{graphNEL,matrix}(from,to="matrix",strict=TRUE) \S4method{coerce}{matrix,graphNEL}(from,to="graphNEL",strict=TRUE) } \arguments{ \item{ft}{An nx2 matrix containing the \code{from/to} representation of graph edges.} \item{W}{An optional vector of edge weights.} \item{V}{An optional vector of node names.} \item{aM}{An affiliation matrix for a bipartite graph.} \item{edgemode}{Character. Specifies if the resulting graph is to be directed or undirected.} \item{from}{Object to coerce from, either of type \code{matrix} or \code{grpahNEL}} \item{to}{Character giving class to coerce to. Either "matrix" or "graphNEL".} \item{strict}{Strict object checking.} } \details{ In the functions \code{ftM2adjM} and \code{ftM2graphNEL}, a \code{from/to} matrix \code{ft} is converted into an \code{adjacency} matrix or a \code{graphNEL} object respectively. In \code{ft}, the first column represents the \code{from} nodes and the second column the \code{to} nodes. To have unconnected nodes, use the \code{V} argument (see below). The \code{edgemode} parameter can be used to specify if the desired output is a directed or undirected graph. The same edge must not occur twice in the \code{from/to} matrix. If \code{edgemode} is \code{undirected}, the edge \code{(u,v)} and \code{(v,u)} must only be specified once. \code{W} is an optional vector of edge weights. The order of the edge weights in the vector should correspond to the order of the edges recorded in \code{ft}. If it is not specified, edge weights of 1 are assigned by default. \code{V} is an optional vector of node names. All elements of \code{ft} must be contained in \code{V}, but not all names in \code{V} need to be contained in \code{ft}. If \code{V} is not specified, it is set to all nodes represented in \code{ft}. Specifying \code{V} is most useful for creating a graph that includes nodes with degree 0. \code{aM} is an affiliation matrix as frequently used in social networks analysis. The rows of \code{aM} represent actors, and the columns represent events. An entry of "1" in the ith row and jth column represents affiliation of the ith actor with the jth event. Weighted entries may also be used. \code{aM2bpG} returns a \code{graphNEL} object with nodes consisting of the set of actors and events, and directed (possibly weighted) edges from the actors to their corresponding events. If plotted using \code{Rgraphviz} and the \code{dot} layout, the bipartite structure of the graph returned by \code{aM2bpG} should be evident. An \code{adjacency} matrix can be coerced into a \code{graphNEL} using the \code{as} method. If the matrix is a symmetric matrix, then the resulting graph will be \code{undirected}, otherwise it will be \code{directed}. } \value{ For \code{ftM2graphNEL} and \code{aM2bpG}, an object of class \code{graphNEL}. For \code{ftM2adjM}, a matrix (the adjacency matrix representation). } \author{Denise Scholtens, Wolfgang Huber} \examples{ ## From-To matrix From <- c("A","A","C","C") To <- c("B","C","B","D") L <- cbind(From,To) W <- 1:4 M1 <- ftM2adjM(L, W, edgemode="directed") M2 <- ftM2adjM(L, W, edgemode="undirected") stopifnot(all(M1+t(M1)==M2)) G1 <- ftM2graphNEL(L, W, edgemode="directed") G2 <- ftM2graphNEL(L, W, edgemode="undirected") ## Adjacency matrix From <- matrix(runif(100), nrow=10, ncol=10) From <- (From+t(From)) > pi/4 rownames(From) <- colnames(From) <- LETTERS[1:10] To <- as(From,"graphNEL") Back <- as(To,"matrix") stopifnot(all(From == Back)) } \keyword{graphs } graph/man/acc-methods.Rd0000644000175000017500000000317114136046755014753 0ustar nileshnilesh\name{acc-methods} \docType{methods} \alias{acc-methods} \alias{acc,graph-method} \alias{acc,clusterGraph-method} \alias{acc} \alias{acc,graph,character-method} \alias{acc,clusterGraph,character-method} \title{Methods for Accessibility Lists} \description{ This generic function takes an object that inherits from the \code{graph} class and a node in that graph and returns a vector containing information about all other nodes that are accessible from the given node. The methods are vectorized so that \code{index} can be a vector. } \usage{ \S4method{acc}{graph,character}(object, index) \S4method{acc}{clusterGraph,character}(object, index) } \arguments{ \item{object}{An instance of the appropriate graph class.} \item{index}{A character vector specifying the nodes for which accessibilty information is wanted.} } \value{ The methods should return a named list of integer vectors. The \code{names} of the list correspond to the names of the supplied nodes. For each element of the list the returned vector is named. The names of the vector elements correspond to the nodes that are accessible from the given node. The values in the vector indicate how many edges are between the given node and the node in the return vector. } \section{Methods}{\describe{ \item{object = graph}{An object of class graph.} \item{object = clusterGraph}{An instance of the \code{clusterGraph} class.} \item{index}{A \code{character} vector of indices corresponding to nodes in the graph.} } } \examples{ set.seed(123) gR3 <- randomGraph(LETTERS[1:10], M<-1:2, p=.5) acc(gR3, "A") acc(gR3, c("B", "D")) } \keyword{methods} graph/man/listEdges.Rd0000644000175000017500000000223614136046755014510 0ustar nileshnilesh\name{listEdges} \alias{listEdges} \title{List the Edges of a Graph } \description{ A list where each element contains all edges between two nodes, regardless of orientation. The list has names which are node pairs, in lexicographic order, and elements all edges between those nodes. } \usage{ listEdges(object, dropNULL=TRUE) } \arguments{ \item{object}{An instance of the \code{\link{graphNEL-class}} class. } \item{dropNULL}{Should those node pairs with no edges be dropped from the returned list. } } \details{ The function is currently only implemented for graphs of the \code{\link{graphNEL-class}}. The edges in the returned list are instances of the \code{\link{simpleEdge-class}}. } \value{ A named list of \code{\link{simpleEdge-class}} objects. } \author{R. Gentleman} \seealso{\code{\link{simpleEdge-class}}, \code{\link{edges}}} \examples{ set.seed(123) V <- LETTERS[1:4] edL <- vector("list", length=4) names(edL) <- V toE <- LETTERS[4:1] for(i in 1:4) edL[[i]] <- list(edges=5-i, weights=runif(1)) gR <- graphNEL(nodes=V, edgeL=edL) listEdges(gR) } \keyword{manip} graph/man/DFS.Rd0000644000175000017500000000313314136046755013176 0ustar nileshnilesh\name{DFS} \alias{DFS} \alias{DFS,graph,character-method} \title{Depth First Search } \description{ This function implements algorithm 4.2.1 of Gross and Yellen. The input is a \code{graph} and a \code{node} to start from. It returns a standard vertex labeling of \code{graph}. This is a vector with elements corresponding to the nodes of \code{graph} and with values that correspond to point in the depth first search the node is visited. } \usage{ DFS(object, node, checkConn=TRUE) } \arguments{ \item{object}{An instance of the \code{graph} class. } \item{node}{A \code{character} indicating the starting node. } \item{checkConn}{A \code{logical} indicating whether the connectivity of the graph should be checked. } } \details{ This function implements algorithm 4.2.1 of Gross and Yellen. Specific details are given there. It requires that the graph be connected. By default, this is checked, but since the checking can be expensive it is optional. A faster and mostly likely better implementation of depth first searching is given by \code{\link[RBGL:bfs]{dfs}} in the \pkg{RBGL} package. } \value{ A vector with names given by the nodes of \code{graph} whose values are \code{0} to one less than the number of nodes. These indices indicate the point at which the node will be visited. } \references{\emph{Graph Theory and its Applications}, J. Gross and J. Yellen. } \author{R. Gentleman } \seealso{\code{\link{boundary}}} \examples{ RNGkind("Mersenne-Twister") set.seed(123) g1 <- randomGraph(letters[1:10], 1:4, p=.3) RNGkind() DFS(g1, "a") } \keyword{manip} graph/man/attrDataItem-methods.Rd0000644000175000017500000000245514136046755016614 0ustar nileshnilesh\name{attrDataItem-methods} \docType{methods} \alias{attrDataItem-methods} \alias{attrDataItem<--methods} \alias{attrDataItem} \alias{attrDataItem<-} \title{Get and set attributes values for items in an attrData object} \usage{ attrDataItem(self, x, attr) attrDataItem(self, x, attr) <- value } \arguments{ \item{self}{A \code{\link{attrData-class}} instance} \item{x}{A \code{character} vector of item names} \item{attr}{A \code{character} vector of length 1 giving the attribute name to get/set. Note that the attribute name must have already been defined for the \code{attrData} object via \code{\link{attrDefaults}}. If missing, return a list of all attributes for the specified nodes.} \item{value}{An R object to set as the attribute value for the specified items. If the object has length one or does not have a length method defined, it will be assigned to all items in \code{x}. If the length of \code{value} is the same as \code{x}, the corresponding elements will be assigned. We will add an argument to indicate that the \code{value} is to be taken as-is for those cases where the lengths are the same coincidentally.} } \description{ The \code{attrDataItem} method provides get/set access to items stored in a \code{\link{attrData-class}} object. } \keyword{methods} graph/man/ugraph.Rd0000644000175000017500000000233614136046755014054 0ustar nileshnilesh\name{ugraph} \alias{ugraph} \alias{ugraph,graph-method} \title{Underlying Graph} \description{ For a \emph{directed} graph the underlying graph is the graph that is constructed where all edge orientation is ignored. This function carries out such a transformation on \code{graphNEL} instances. } \usage{ ugraph(graph) } \arguments{ \item{graph}{a \code{graph} object. } } \details{ If \code{graph} is already \emph{undirected} then it is simply returned. If \code{graph} is a multi-graph (has multiple edges) an error is thrown as it is unclear how to compute the underlying graph in that context. The method will work for any \code{graph} subclass for which an \code{edgeMatrix} method exists. } \value{ An instance of \code{graphNEL} with the same nodes as the input but which is \code{undirected}. } \references{Graph Theory and its Applications, J. Gross and J. Yellen. } \author{R. Gentleman } \seealso{ \code{\link{connComp}} \code{\link{edgeMatrix}} } \examples{ V <- letters[1:4] edL2 <- vector("list", length=4) names(edL2) <- V for(i in 1:4) edL2[[i]] <- list(edges=c(2,1,2,1)[i], weights=sqrt(i)) gR2 <- graphNEL(nodes=V, edgeL=edL2, edgemode="directed") ugraph(gR2) } \keyword{manip} graph/man/graphBAM-class.Rd0000644000175000017500000002652014136046755015313 0ustar nileshnilesh\name{graphBAM-class} \Rdversion{1.1} \docType{class} \alias{graphBAM-class} \alias{addEdge,character,character,graphBAM,missing-method} \alias{addEdge,character,character,graphBAM,numeric-method} \alias{edgemode<-,graphBAM,character-method} \alias{clearNode,character,graphBAM-method} \alias{edges,graphBAM-method} \alias{inEdges,character,graphBAM-method} \alias{initialize,graphBAM-method} \alias{isAdjacent,graphBAM,character,character-method} \alias{nodes,graphBAM-method} \alias{show,graphBAM-method} \alias{numEdges,graphBAM-method} \alias{numNodes,graphBAM-method} \alias{removeEdge,character,character,graphBAM-method} \alias{removeNode,character,graphBAM-method} \alias{edgeWeights,graphBAM-method} \alias{edgeWeights,graphBAM,character-method} \alias{edgeWeights,graphBAM,numeric-method} \alias{edgeWeights,graphBAM,missing-method} \alias{edgeData,graphBAM,character,character,character-method} \alias{edgeData,graphBAM,character,missing,character-method} \alias{edgeData,graphBAM,missing,character,character-method} \alias{edgeData,graphBAM,missing,missing,missing-method} \alias{edgeData,graphBAM,missing,missing,character-method} \alias{edgeData<-,graphBAM,character,character,character-method} \alias{edgeData<-,graphBAM,missing,character,character-method} \alias{edgeData<-,graphBAM,character,missing,character-method} \alias{edgeData<-,graphBAM,missing,missing,character-method} \alias{edgeData<-,graphBAM,character,character,character,ANY-method} \alias{edgeData<-,graphBAM,missing,character,character,ANY-method} \alias{edgeData<-,graphBAM,character,missing,character,ANY-method} \alias{edgeData<-,graphBAM,missing,missing,character,ANY-method} \alias{edgeDataDefaults<-,graphBAM,character,ANY-method} \alias{edgeDataDefaults<-,graphBAM,missing,list-method} \alias{nodeDataDefaults<-,graphBAM,missing,list-method} \alias{graphBAM} \alias{coerce,graphBAM,graphAM-method} \alias{coerce,graphBAM,graphNEL-method} \alias{coerce,graphBAM,matrix-method} \alias{extractFromTo,graphBAM-method} \alias{ugraph,graphBAM-method} \alias{adj,graphBAM,character-method} \alias{graphIntersect} \alias{graphIntersect,graphBAM,graphBAM-method} \alias{graphUnion} \alias{graphUnion,graphBAM,graphBAM-method} \alias{nodes<-,graphBAM,character-method} \alias{removeEdgesByWeight} \alias{removeEdgesByWeight,graphBAM-method} \alias{nodeDataDefaults,graphBAM,character-method} \alias{nodeDataDefaults,graphBAM,missing-method} \alias{nodeDataDefaults<-,graphBAM,character,ANY-method} \alias{nodeDataDefaults<-,graphBAM,missing,ANY-method} \alias{nodeData,graphBAM,character,character-method} \alias{nodeData,graphBAM,character,missing-method} \alias{nodeData,graphBAM,missing,character-method} \alias{nodeData,graphBAM,missing,missing-method} \alias{nodeData<-,graphBAM,character,character-method} \alias{nodeData<-,graphBAM,missing,character-method} \title{EXPERIMENTAL class "graphBAM"} \description{ The graphBAM class represents a graph as an adjacency matrix. The adjacency matrix is stored as a bit array using a \code{raw} vector to reduce the memory footprint and speed operations like \code{graphIntersection}. This class is EXPERIMENTAL and its API is subject to change. } \usage{ graphBAM(df, nodes=NULL, edgemode="undirected", ignore_dup_edges = FALSE) } \arguments{ \item{df}{ A \code{data.frame} with three columns: "from", "to" and "weight". Columns "from" and "to" can be either factors or character vectors. Each row of \code{df} describes an edge in the resulting graph. The "weight" column must be numeric. } \item{nodes}{ A character vector of node labels. Use this to add degree zero nodes to the graph. If \code{NULL}, the set of nodes found in \code{from} and \code{to} will be used. } \item{edgemode}{ A string, one of "directed" or "undirected". } \item{ignore_dup_edges}{ If \code{FALSE} (default), specifying duplicate edges in the input is an error. When set to \code{TRUE} duplicate edges are ignored. Edge weight values are ignored when determining duplicates. This is most useful for graph import and conversion. } } \section{Constructors}{ The \code{GraphBAM} function is used to create new \code{graphBAM} instances. Edges are specified in a \code{data.frame}. For undirected graphs, reciprical edges should not be includes unless \code{ignoe_dup_edges} is \code{TRUE}. } \section{Extends}{ Class \code{"\linkS4class{graph}"}, directly. } \section{Methods for graphBAM objects}{ \describe{ \item{\code{addEdge(from, to, graph, weights)}}{ Return a new \code{graphBAM} object with the specified edge(s) added. The \code{from} and \code{to} arguments must either be the same length or one of them must be of length one. Each time an edge is added, the entire graph is copied. For the purpose of building a graph it will often be more efficient to build up the list of edges and call \code{GraphBAM}. } \item{\code{addNode(node, object)}}{ Return a new \code{graphBAM} object with the specified node(s) added. } \item{\code{clearNode(node, object)}}{ This operation is not currently supported. } \item{\code{edges(object, which)}}{ Returns an adjacency list representation of the graph. The list will have an entry for each node with a vector of adjacent node labels or \code{character(0)}. For undirected graphs, \code{edges} returns the reciprocal edges. The optional argument \code{which} can be a character vector of node labels. When present, only entries for the specified nodes will be returned. } \item{\code{inEdges(node, object)}}{ (Not yet supported) Similar to the \code{edges} function, but the adjacency list maps nodes that have an edge to the given node instead of from the given node. } \item{\code{isAdjacent(object, from, to)}}{ Returns a logical vector indicating whether there is an edge corresponding to the elements in \code{from} and \code{to}. These vectors must have the same length, unless one has length one. } \item{\code{nodes(object)}}{ Return the node labels for the graph } \item{\code{numEdges(object)}}{ Returns the number of edges in the graph. } \item{\code{numNodes(object)}}{ Returns the number of nodes in the graph } \item{\code{removeEdge(from, to, graph)}}{ Return a new \code{graphBAM} object with the specified edges removed. The \code{from} and \code{to} arguments must be the same length unless one of them has length one. } \item{\code{removeNode(node, object)}}{ Returns a new \code{graphBAM} object with the specified node removed. Node and edge attributes corresponding to that node are also removed. } \item{\code{edgeData(self, from, to, attr)}}{ Access edge attributes. See help for \code{edgeData}. } \item{\code{edgeDataDefaults(self, attr)}}{ Access edge data default attributes . } \item{\code{nodeDataDefaults(self, attr)}}{ Access node data default attributes . } \item{\code{edgeWeights(object, index)}}{ Return the edge weights for the graph in adjacency list format. The optional argument \code{index} specified a character vector of nodes. In this case, only the weights for the specified nodes will be returned. } \item{\code{extractFromTo(g)}}{ Returns a data frame with column names "from", "to", and "weight" corresponding to the connected nodes in the graphBAM object. } \item{\code{graphIntersect(x, y, nodeFun, edgeFun)}}{ When given two \code{graphBAM} objects, \code{graphIntersect} returns a new \code{graphBAM} containing the nodes and edges in common between the two graphs. Both x and y should either be directed or undirected. The intersection is computed by first finding the intersection of the node sets, obtaining the resulting subgraphs, and finding the intersection of the resulting edge sets. Node/Edge attributes that are equal are carried over to the result. Non equal edge/node attributes will result in the corresponding attribute being set to NA. The user has the option of providing a named list of functions correspoding to the names of the edge attributes for resolving conflicting edge attributes. For resolving any of the conflicting node attributes the user has the option of providing a named \code{list} of functions corresponding to the node attribute names. } \item{\code{graphUnion(x, y, nodeFun, edgeFun)}}{ When given two \code{graphBAM} objects, \code{graphUnion} returns a new \code{graphBAM} containing the union of nodes and edges between the two graphs. The union is compted by first finding the union of the nodesets. Both x and y should be either directed or undirected. Node/Edge attributes that are equal are carried over to the result. Non equal edge/node attributes will result in the corresponding attribute being set to NA. The user has the option of providing a named list of functions correspoding to the names of the edge attributes for resolving conflicting edge attributes. For resolving any of the conflicting node attributes the user has the option of providing a named \code{list} of functions corresponding to the node attribute names. } \item{\code{edgemode(object) <- value}}{ Set the edgemode for the graph ("directed" or "undirected"). If the specified edgemode is the same, the object is returned without changes. Otherwise, a directed graph is converted to an undirected graph via \code{ugraph} and an undirected graph is returned such that each edge is interpreted as two edges, one in each direction. } \item{\code{ugraph(graph)}}{ Return an undirected version of the current graph. Conceptually, the arrows of a graph's directed edges are removed. } \item{\code{nodes(object) <- value}}{ Replacement of a \code{graphBAM} object's node labels is currently not supported. An error is raised if this method is called. } } } \section{Coercion}{ \code{graphBAM} objects can be coerced to \code{graphAM}, \code{graphNEL}, and \code{matrix} instances via \code{as(g, CLASS)}. } \author{N. Gopalakrishnan, S. Falcon} \examples{ f <- c("a", "a", "b", "c", "d") t <- c("b", "c", "c", "d", "a") weight <- c(2.3, 2.3, 4.3, 1.0, 3.0) df <- data.frame(from=f, to=t, weight= weight, stringsAsFactors = TRUE) g <- graphBAM(df) nd <- nodes(g) nodeDataDefaults(g, attr ="color") <- "green" nodeData(g,n=c("b", "c"), attr ="color") <- "red" w1 <- edgeWeights(g) w2 <- edgeWeights(g,"a") w3 <- edgeWeights(g,1) d1 <- edges(g) d2 <- edges(g,c("a", "b")) e1 <- edgeData(g) e2 <- edgeData(g, "a", "c",attr="weight") em <- edgeMatrix(g) id <- isDirected(g) sg <- subGraph(c("a","c","d"), g) ft <- extractFromTo(g) am <- as(g,"graphAM") nl <- as(g,"graphNEL") mt <- as(g,"matrix") k <- graphIntersect(g,g) k <- graphUnion(g,g) e <- removeEdgesByWeight(g,lessThan= 3.0) f <- removeNode("a", g) g } \keyword{classes} graph/man/numNoEdges.Rd0000644000175000017500000000114414136046755014626 0ustar nileshnilesh\name{numNoEdges} \alias{numNoEdges} \title{ Calculate the number of nodes that have an edge list of NULL } \description{ \code{numNoEdges} calculates the number of nodes that have an edge list of NULL (i.e. no edges). } \usage{ numNoEdges(objGraph) } \arguments{ \item{objGraph}{ the graph object } } \value{ An integer representing the number of NULL edge lists in the graph. } \author{ Elizabeth Whalen } \seealso{ \code{\link{numEdges}}, \code{\link{aveNumEdges}}, \code{\link{mostEdges}} } \examples{ set.seed(999) g1 <- randomEGraph(letters, .01) numNoEdges(g1) } \keyword{ manip } graph/man/MAPKsig.Rd0000644000175000017500000000151214136046755014014 0ustar nileshnilesh\name{MAPKsig} \alias{MAPKsig} \non_function{} \title{ A graph encoding parts of the MAPK signaling pathway } \description{ A graph encoding parts of the MAPK signaling pathway } \usage{data(MAPKsig)} \format{ The format is: Formal class 'graphNEL' [package "graph"] with edgemode "directed". } \source{ The KEGG pancreatic cancer pathway was visually inspected on 17 Sept 2007, and the subgraph associated with MAPK signaling was isolated. The HUGO names for each symbol in the KEGG visualization were obtained and checked for existance on hgu95av2. Some abbreviated terms for processes are also included as nodes. } %\references{ % %} \examples{ data(MAPKsig) if (require(Rgraphviz)) { nat = rep(FALSE, length(nodes(MAPKsig))) names(nat) = nodes(MAPKsig) plot(MAPKsig, nodeAttrs=list(fixedsize=nat)) } } \keyword{models} graph/man/edgeData-methods.Rd0000644000175000017500000000163414136046755015725 0ustar nileshnilesh\name{edgeData-methods} \docType{methods} \alias{edgeData-methods} \alias{edgeData<--methods} \alias{edgeData} \alias{edgeData<-} \title{Get and set attributes for the edges of a graph object} \usage{ edgeData(self, from, to, attr) edgeData(self, from, to, attr) <- value } \arguments{ \item{self}{A \code{graph-class} instance} \item{from}{A \code{character} vector of node names} \item{to}{A \code{character} vector of node names} \item{attr}{A \code{character} vector of length one specifying the name of a node attribute} \item{value}{An R object to store as the attribute value} } \description{ Attributes of the edges of a graph can be accessed using \code{edgeData}. The attributes must be defined using \code{\link{edgeDataDefaults}}. You can ommit the \code{from} or \code{to} argument to retrieve attribute values for all edges to (respectively, from) a given node. } \keyword{methods} graph/man/boundary.Rd0000644000175000017500000000271614136046755014413 0ustar nileshnilesh\name{boundary} \alias{boundary} \title{ Returns the Boundary between a Graph and a SubGraph } \description{ The boundary of a subgraph is the set of nodes in the original graph that have edges to nodes in the subgraph. The function \code{boundary} computes the boundary and returns it as a list whose length is the same length as the number of nodes in the subgraph. } \usage{ boundary(subgraph, graph) } \arguments{ \item{graph}{ the original graph from which the boundary will be created } \item{subgraph}{ can either be the vector of the node labels or the subgraph itself.} } \details{ The \emph{boundary} of a \emph{subgraph} is the set of nodes in the graph which have an edge that connects them to the specified subgraph but which are themselves not elements of the subgraph. For convenience users can specify the subgraph as either a graph or a vector of node labels. } \value{ This function returns a named list of length equal to the number of nodes in \code{subgraph}. The elements of the list correspond to the nodes in the \code{subgraph}. The elements are lists of the nodes in \code{graph} which share an edge with the respective node in \code{subgraph}. } \author{ Elizabeth Whalen and R. Gentleman } \seealso{ \code{\link{subGraph}}, \code{\link{graph-class}} } \examples{ set.seed(123) g1 <- randomGraph(letters[1:10], 1:4, p=.3) ##both should be "a" boundary(c("g", "i"), g1) } \keyword{ manip } graph/man/clusteringCoefficient-methods.Rd0000644000175000017500000000300114136046755020533 0ustar nileshnilesh\name{clusteringCoefficient-methods} \docType{methods} \alias{clusteringCoefficient} \alias{clusteringCoefficient,graph-method} \alias{clusteringCoefficient,graph} \title{Clustering coefficient of a graph} \description{ This generic function takes an object that inherits from the \code{graph} class. The graph needs to have \code{edgemode=="undirected"}. If it has \code{edgemode=="directed"}, the function will return NULL. } \usage{ \S4method{clusteringCoefficient}{graph}(object, selfLoops=FALSE) } \details{For a node with n adjacent nodes, if \code{selfLoops} is \code{FALSE}, the clustering coefficent is N/(n*(n-1)), where N is the number of edges between these nodes. The graph may not have self loops. If \code{selfLoops} is \code{TRUE}, the clustering coefficent is N/(n*n), where N is the number of edges between these nodes, including self loops. } \arguments{ \item{object}{An instance of the appropriate graph class.} \item{selfLoops}{Logical. If true, the calculation takes self loops into account.} } \value{A named numeric vector with the clustering coefficients for each node. For nodes with 2 or more edges, the values are between 0 and 1. For nodes that have no edges, the function returns the value NA. For nodes that have exactly one edge, the function returns NaN. } \author{Wolfgang Huber \url{http://www.dkfz.de/mga/whuber}} \examples{ set.seed(123) g1 <- randomGraph(letters[1:10], 1:4, p=.3) clusteringCoefficient(g1) clusteringCoefficient(g1, selfLoops=TRUE) } \keyword{methods} graph/man/reverseEdgeDirections.Rd0000644000175000017500000000164414136046755017053 0ustar nileshnilesh\name{reverseEdgeDirections} \alias{reverseEdgeDirections} \title{Reverse the edges of a directed graph} \description{ Return a new directed graph instance with each edge oriented in the opposite direction relative to the corresponding edge in the input graph. } \usage{ reverseEdgeDirections(g) } \arguments{ \item{g}{A \code{graph} subclass that can be coerced to \code{graphAM}} } \details{ WARNING: this doesn't handle edge attributes properly. It is a preliminary implementation and subject to change. } \value{ A \code{graphNEL} instance } \author{S. Falcon} \examples{ g <- graphNEL(nodes=c("a", "b", "c"), edgeL=list(a=c("b", "c"), b=character(0), c=character(0)), edgemode="directed") stopifnot(isAdjacent(g, "a", "b")) stopifnot(!isAdjacent(g, "b", "a")) grev <- reverseEdgeDirections(g) stopifnot(!isAdjacent(grev, "a", "b")) stopifnot(isAdjacent(grev, "b", "a")) } \keyword{manip} graph/man/removeEdge.Rd0000644000175000017500000000222714136046755014647 0ustar nileshnilesh\name{removeEdge} \alias{removeEdge} \title{ removeEdge } \description{ A function to remove the specified edges from a graph. } \usage{ removeEdge(from, to, graph) } \arguments{ \item{from}{from edge labels } \item{to}{ to edge labels} \item{graph}{a \code{graph} object } } \details{ A new graph instance is returned with the edges specified by corresponding elements of the \code{from} and \code{to} vectors removed. If \code{from} and \code{to} are not the same length, one of them should have length one. All edges to be removed must exist in \code{graph}. } \value{ A new instance of a graph with the same class as \code{graph} is returned with the specified edges removed. } \author{R. Gentleman} \seealso{\code{\link{addNode}},\code{\link{addEdge}},\code{\link{removeNode}}} \examples{ V <- LETTERS[1:4] edL1 <- vector("list", length=4) names(edL1) <- V for(i in 1:4) edL1[[i]] <- list(edges=c(2,1,4,3)[i], weights=sqrt(i)) gR <- graphNEL(nodes=V, edgeL=edL1) gX <- removeEdge("A", "B", gR) set.seed(123) g <- randomEGraph(V=letters[1:5],edges=5) g2 <- removeEdge(from=c("a","b"), to=c("c","e"), g) } \keyword{manip} graph/man/adj-methods.Rd0000644000175000017500000000176414136046755014771 0ustar nileshnilesh\name{adj-methods} \docType{methods} \alias{adj} \title{ Methods for finding the adjacency list for selected nodes. } \alias{adj-methods} \description{ This generic function takes an object that inherits from the \code{graph} class and a node in that graph and returns a vector containing information about all other nodes that are adjacent to the given node. This means that they are joined to the given node by an edge. The accessibility list, \code{\link{acc}} is the list of all nodes that can be reached from a specified node. } \value{ The methods return vector of nodes that are adjacent to the specified node. } \section{Methods}{\describe{ \item{object = graph}{An object that inherits from glass \code{graph}} \item{index}{An index (could be multiple) which can be either the integer offset for the node(s) or their labels.} }} \seealso{\code{\link{acc-methods}}} \examples{ set.seed(123) gR3 <- randomGraph(LETTERS[1:4], M<-1:2, p=.5) adj(gR3, "A") adj(gR3, c(2,3)) } \keyword{methods} graph/man/multigraph.Rd0000644000175000017500000000362714136046755014746 0ustar nileshnilesh\name{multiGraph-class} \docType{class} \alias{multiGraph-class} \alias{edgeSet-class} \alias{edgeSetNEL-class} \alias{edgeSetAM-class} \alias{show,multiGraph-method} \alias{show,edgeSet-method} \alias{isDirected,multiGraph-method} \alias{isDirected,edgeSet-method} \alias{edgemode,edgeSet-method} \alias{nodes,multiGraph-method} \alias{nodes,edgeSetAM-method} \alias{numNodes,multiGraph-method} \alias{edges,multiGraph-method} \alias{edges,edgeSetAM-method} \alias{edges,edgeSetNEL-method} \alias{numEdges,edgeSetAM-method} \alias{numEdges,multiGraph-method} \title{Class "multiGraph" } \description{A collection of classes to model multigraphs. These include the multiGraph class as well as classes to contain edge sets. } \section{Objects from the Class}{ Objects can be created from the \code{multiGraph} class, the \code{edgeSet} class is virtual, and particular variants should be used. } \section{Slots}{ These slots are for the multiGraph class. \describe{ \item{nodes}{The names of the nodes.} \item{edgeL}{A list of edge lists.} \item{nodeData}{An instance of the \code{attrData} class.} \item{graphData}{A list.} } These slots are for the \code{edgeSet} class, or one of its sublcasses. \describe{ \item{edgeData}{An instance of the \code{attrData} class.} \item{edgemode}{A character vector, one of directed, or undirected.} \item{edgeL}{A list of the edges (graphNEL)} \item{adjMat}{An adjacency matrix (graphAM)} } } \section{Methods}{ \describe{ \item{show}{Print a multigraph.} \item{isDirected}{A vector indicating which of the edgeSets is directed.} \item{nodes}{Retrieve the node names} \item{numNodes}{Return the number of nodes} \item{edges}{Return either all edges, or a subset of them, depending on the arguments supplied.} \item{numEdges}{Return a vector with the number of edges, for each edge set.} } } \keyword{classes} graph/man/graphExamples.Rd0000644000175000017500000000064514136046755015367 0ustar nileshnilesh\name{graphExamples} \alias{graphExamples} \docType{data} \title{A List Of Example Graphs} \description{ This data set contains a list of example \code{graphNEL} objects, which can then be used for plotting. } \usage{data(graphExamples)} \source{ Various sources, primarily from \code{\link{randomGraph}} and \code{\link{randomEGraph}} } \examples{ data(graphExamples) a <- graphExamples[[1]] a } \keyword{datasets} graph/man/combineNodes.Rd0000644000175000017500000000342414136046755015172 0ustar nileshnilesh\name{combineNodes} \alias{combineNodes} \alias{combineNodes,character,graphNEL,character-method} \title{ combineNodes } \description{ A function to combine, or collapse, a specified set of nodes in a graph. } \usage{ combineNodes(nodes, graph, newName, \dots) \S4method{combineNodes}{character,graphNEL,character}(nodes, graph, newName, collapseFunction=sum) } \arguments{ \item{nodes}{A set of nodes that are to be collapsed. } \item{graph}{The graph containing the nodes } \item{newName}{The name for the new, collapsed node. } \item{collapseFunction}{Function or character giving the name of a function used to collapse the edge weights after combining nodes. The default is to sum up the weights, but mean would be a useful alternative.} \item{\dots}{Additional arguments for the generic} } \details{ The nodes specified are reduced to a single new node with label given by \code{newName}. The in and out edges of the set of nodes are all made into in and out edges for the new node. } \value{ An new instance of a graph of the same class as \code{graph} is returned. This new graph has the specified nodes reduced to a single node. } \author{R. Gentleman} \seealso{\code{\link{inEdges}}, \code{\link{addNode}}} \examples{ V <- LETTERS[1:4] edL1 <- vector("list", length=4) names(edL1) <- V for(i in 1:4) edL1[[i]] <- list(edges=c(2,1,4,3)[i], weights=sqrt(i)) gR <- graphNEL(nodes=V, edgeL=edL1, edgemode="directed") gR <- addNode("M", gR) gR <- addEdge("M", "A", gR, 1) gR <- addEdge("B", "D", gR, 1) gX <- combineNodes(c("B","D"), gR, "X") gR <- addNode("K", gR) gR <- addEdge(c("K","K"), c("D", "B"), gR, c(5,3)) edgeWeights(combineNodes(c("B","D"), gR, "X"))$K edgeWeights(combineNodes(c("B","D"), gR, "X", mean))$K } \keyword{ manip} graph/man/renderInfo-class.Rd0000644000175000017500000001270514136046755015765 0ustar nileshnilesh\name{renderInfo-class} \docType{class} \alias{renderInfo-class} \alias{edgeRenderInfo} \alias{edgeRenderInfo<-} \alias{nodeRenderInfo} \alias{nodeRenderInfo<-} \alias{parRenderInfo} \alias{parRenderInfo<-} \alias{graphRenderInfo} \alias{graphRenderInfo<-} \title{Class "renderInfo"} \description{A container class to manage graph rendering attributes. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("renderInfo")} or by using the initializer \code{.renderInfoPrototype}. } \section{Slots}{ \describe{ \item{\code{pars}:}{List of default rendering attributes with two items \code{nodes} and \code{edges}. When not set further down the parameter hierarchy, these defaults will be used for all nodes/edges in the graph. } \item{\code{nodes}:}{Named list of attributes specific to nodes. } \item{\code{edges}:}{Named list of attributes specific to edges. } \item{\code{graph}:}{Named list of graph-wide attributes. } } Each item of \code{nodes} and \code{edges} can take arbitrary vectors, the only restriction is that they have to be of either length 1 or length equal to the number of nodes or edges, respectively. \code{pars} and \code{graph} can take arbitrary skalars, the latter for both edges and nodes. } \section{Methods}{ The following are functions rather than methods and build the API to control the graphical output of a graph when it is plotted using \code{\link[Rgraphviz]{renderGraph}}. \describe{ \item{parRenderInfo, parRenderInfo<-}{getter and setter for items of slot \code{pars}} \item{nodeRenderInfo, nodeRenderInfo<-}{getter and setter for items of slot \code{nodes}} \item{edgeRenderInfo, edgeRenderInfo<-}{getter and setter for items of slot \code{edges}} \item{graphRenderInfo, graphRenderInfo<-}{getter and setter for items of slot \code{graph}} } The getters all take two arguments: \code{g} is a graph object and \code{name} is a character giving the name of one of the item in the respective slot. When \code{name} is missing this will give you the whole list. The setters are a bit more complex: \code{nodeRenderInfo<-} and \code{edgeRenderInfo<-} can take \describe{ \item{named list of named vectors}{where the names have to match the node or edge names. Items in the vector that don't match a valid edge or node name will be silently ignored. For undirected edges the order of head nodes and tail nodes in edge names is ignored, i.e. \code{a~b} is equivalent to code{b~a}} \item{named list of skalars}{which will set all the attribute for all edges or nodes in the graph} \code{parRenderInfo<-}{will only take a list with items \code{nodes}, \code{edges} and \code{graph}. The content of these list items can be arbitrary named vectors.} \code{parRenderInfo<-}{takes an arbitrary list} } Available rendering parameters for nodes are: \describe{ \item{col:}{ the color of the line drawn as node border. Defaults to \code{black}.} \item{lty:}{ the type of the line drawn as node border. Defaults to \code{solid}. Valid values are the same as for the R's base graphic parameter \code{lty}.} \item{lwd:}{ the width of the line drawn as node border. Defaults to \code{1}. Note that the underlying low level plotting functions do not support vectorized \code{lwd} values. Instead, only the first item of the vector will be used. } \item{fill:}{ the color used to fill a node. Defaults to \code{transparent}.} \item{textCol:}{ the font color used for the node labels. Defaults to \code{black}.} \item{fontsize: }{the font size for the node labels in points. Defaults to \code{14}. Note that the fontsize will be automatically adjusted to make sure that all labels fit their respective nodes. You may want to increase the node size by supplying the appropriate layout parameters to \code{Graphviz} in order to allow for larger fontsizes.} \item{cex:}{ Expansion factor to further control the fontsize. As default, this parameter is not set, in which case the fontsize will be clipped to the node size. This mainly exists to for consistency with the base graphic parameters and to override the clipping of fontsize to nodesize.} } Available rendering parameters for edges are: \describe{ \item{col:}{ the color of the edge line. Defaults to \code{black}.} \item{lty:}{ the type of the edge line. Defaults to \code{solid}. Valid values are the same as for the R's base graphic parameter \code{lty}.} \item{lwd:}{ the width of the edge line. Defaults to \code{1}.} \item{textCol:}{ the font color used for the edge labels. Defaults to \code{black}.} \item{fontsize:}{ the font size for the edge labels in points. Defaults to \code{14}.} \item{cex:}{ Expansion factor to further control the fontsize. This mainly exists to be consistent with the base graphic parameters.} } } \author{Deepayan Sarkar, Florian Hahne} \examples{ g <- randomGraph(letters[1:4], 1:3, p=0.8) nodeRenderInfo(g) <- list(fill=c("a"="red", "b"="green")) edgeRenderInfo(g) <- list(lwd=3) edgeRenderInfo(g) <- list(lty=3, col="red") parRenderInfo(g) <- list(edges=list(lwd=2, lty="dashed"), nodes=list(col="gray", fill="gray")) nodeRenderInfo(g) edgeRenderInfo(g, "lwd") edgeRenderInfo(g, c("lwd", "col")) parRenderInfo(g) } \keyword{classes} graph/man/isAdjacent-methods.Rd0000644000175000017500000000153414136046755016273 0ustar nileshnilesh\name{isAdjacent-methods} \docType{methods} \alias{isAdjacent-methods} \alias{isAdjacent} \title{Determine if nodes share an edge in a graph} \usage{ isAdjacent(object, from, to, ...) } \arguments{ \item{object}{An instance of a subclass of \code{\link{graph-class}}.} \item{from}{A \code{character} vector of nodes in the graph.} \item{to}{A \code{character} vector of nodes in the graph} \item{...}{May be used by methods called on subclasses of \code{graph}} } \description{ For a given subclass of \code{graph-class}, returns \code{TRUE} if the graph contains an edge from node specified by \code{from} to the node specified by \code{to}. The appropriate logical vector will be returned as long as \code{from} and \code{to} have the same length and contain nodes in the graph object specified by \code{object}. } \keyword{methods} graph/man/calcSumProb.Rd0000644000175000017500000000332514136046755014777 0ustar nileshnilesh\name{calcSumProb} \alias{calcSumProb} \title{ Calculate the probability that a subgraph has an unusual number of edges.} \description{ For any graph a set of nodes can be used to obtain an induced subgraph (see \code{\link{subGraph}}). An interesting question is whether that subgraph has an unusually large number of edges. This function computes the probability that a \emph{random} subgraph with the same number of nodes has more edges than the number observed in the presented subgraph. The appropriate probability distribution is the hypergeometric. } \usage{ calcSumProb(sg, g) } \arguments{ \item{sg}{ subgraph made from the original graph } \item{g}{ original graph object from which the subgraph was made } } \value{ The probability of having greater than or equal to the subgraph's number of edges is returned. } \details{ The computation is based on the following argument. In the original graph there are \eqn{n} nodes and hence \eqn{N=n*(n-1)/2} edges in the complete graph. If we consider these \eqn{N} nodes to be of two types, corresponding to those that are either in our graph, \code{g}, or not in it. Then we think of the subgraph which has say \eqn{m} nodes and \eqn{M=m*(m-1)/2} possible edges as representing \eqn{M} draws from an urn containing \eqn{N} balls of which some are white (those in \code{g}) and some are black. We count the number of edges in the subgraph and use a Hypergeomtric distribution to ask whether our subgraph is particularly dense. } \author{ Elizabeth Whalen } \seealso{ \code{\link{calcProb}} } \examples{ set.seed(123) V <- letters[14:22] g1 <- randomEGraph(V, .2) sg1 <- subGraph(letters[c(15,17,20,21,22)], g1) calcSumProb(sg1, g1) } \keyword{ manip } graph/man/graph2SparseM.Rd0000644000175000017500000000350514136046755015243 0ustar nileshnilesh\name{graph2SparseM} \alias{graph2SparseM} \alias{sparseM2Graph} \title{Coercion methods between graphs and sparse matrices } \description{ These functions provide coercions between objects that inherit from the \code{graph} class to sparse matrices from the \code{SparseM} package. } \usage{ graph2SparseM(g, useweights=FALSE) sparseM2Graph(sM, nodeNames, edgemode=c("directed", "undirected")) } \arguments{ \item{g}{An instance of the \code{graph} class. } \item{useweights}{A logical value indicating whether to use the edge weights in the graph as values in the sparse matrix.} \item{sM}{A sparse matrix.} \item{nodeNames}{A \code{character} vector of the node names.} \item{edgemode}{Specifies whether the graph to be created should have directed (default) or undirected edges. If undirected, the input matrix \code{sM} must be symmetric.} } \details{ A very simple coercion from one representation to another. Currently it is presumed that the matrix is square. For other graph formats, such as bipartite graphs, some improvements will be needed; patches are welcome. } \value{ \code{graph2SparseM} takes as input an instance of a subclass of the \code{graph} class and returns a sparse matrix. \code{sparseM2Graph} takes a sparse matrix as input and returns an instance of the \code{graphNEL} class. By default, the \code{graphNEL} returned will have directed edges. } \author{R. Gentleman } \seealso{ \code{\link{graph-class}}, \code{\link{graphNEL-class}}, and for other conversions, \code{\link{aM2bpG}} and \code{\link{ftM2adjM}} } \examples{ set.seed(123) g1 <- randomGraph(letters[1:10], 1:4, p=.3) s1 <- graph2SparseM(g1, useweights=TRUE) g2 <- sparseM2Graph(s1, letters[1:10], edgemode="undirected") ## consistency check stopifnot(all.equal(g1, g2)) } \keyword{manip} graph/man/distGraph-class.Rd0000644000175000017500000000444414136046755015620 0ustar nileshnilesh\name{distGraph-class} \docType{class} \alias{distGraph-class} \alias{threshold} \alias{Dist} \alias{[.dist} \alias{distGraph-class} \alias{adj,distGraph,ANY-method} \alias{Dist,distGraph-method} \alias{edges,distGraph-method} \alias{edgeL,distGraph-method} \alias{nodes,distGraph-method} \alias{numNodes,distGraph-method} \alias{show,distGraph-method} \alias{threshold,distGraph-method} \alias{edgeWeights,distGraph-method} \alias{edgeWeights,distGraph,ANY-method} \alias{initialize,distGraph-method} \title{Class "distGraph"} \description{ A class definition for graphs that are based on distances.} \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("distGraph", ...)}. } \section{Slots}{ \describe{ \item{\code{Dist}:}{Object of class \code{"dist"} that forms the basis for the edge weights used in the \code{distGraph}.} } } \section{Extends}{ Class \code{"graph"}, directly. } \section{Methods}{ \describe{ \item{show}{\code{signature(object = "distGraph")}: a print method} \item{Dist}{\code{signature(object = "distGraph")}: return the dist object. } \item{adj}{\code{signature(object = "distGraph")}: find the nodes adjacent to the supplied node. } \item{nodes}{\code{signature(object = "distGraph")}: return the nodes in the graph. } \item{numNodes}{\code{signature(object = "distGraph")}: return the number of nodes. } \item{threshold}{\code{signature(object = "distGraph", k, value)}: set all distances that are larger than the supplied threshold, \code{k}, to the supplied value. The default is value is zero (and so is appropriate for similarities, rather than distances). } \item{initialize}{\code{signature(object = "distGraph")}: initialize a \code{distGraph} instance. } \item{edgeWeights}{Return a list of edge weights in a list format similar to the \code{edges} method.} \item{edgeL}{\code{signature(graph = "distGraph")}: A method for obtaining the edge list.} } } \references{Shamir's paper and Butte et al} \author{R. Gentleman } \seealso{\code{\link{graph-class}}, \code{\link{clusterGraph-class}}} \examples{ set.seed(123) x <- rnorm(26) names(x) <- letters library(stats) d1 <- dist(x) g1 <- new("distGraph", Dist=d1) } \keyword{classes} graph/man/aveNumEdges.Rd0000644000175000017500000000116714136046755014772 0ustar nileshnilesh\name{aveNumEdges} \alias{aveNumEdges} \title{ Calculate the average number of edges in a graph } \description{ aveNumEdges divides the number of edges in the graph by the number of nodes to give the average number of edges. } \usage{ aveNumEdges(objgraph) } \arguments{ \item{objgraph}{ the graph object } } \value{ A double representing the average number of edges will be returned. } \author{ Elizabeth Whalen } \seealso{ \code{\link{numEdges}}, \code{\link{mostEdges}}, \code{\link{numNoEdges}} } \examples{ set.seed(124) g1 <- randomGraph(1:10, letters[7:12], p=.6) aveNumEdges(g1) } \keyword{ manip } graph/man/adjacencyMatrix.Rd0000644000175000017500000000213214136046755015666 0ustar nileshnilesh\name{adjacencyMatrix} \alias{adjacencyMatrix} \alias{adjacencyMatrix,graphBAM-method} \title{Compute an Adjacency Matrix for a graphBAM object } \description{ Though unwieldy for large matrices, a full adjacency matrix can be useful for debugging and export. If the graph is \dQuote{undirected} then recicprocal edges are explicit in the matrix. } \usage{ adjacencyMatrix(object) } \arguments{ \item{object}{A \code{graphBAM} object. } } \details{ Thus far only implemented for \code{graphBAM} objects. } \value{ \code{adjacencyMatrix} returns an n x n matrix, where n is the number of nodes in the graph, ordered in the same manner as seen in the \code{nodes} method. All cells in the matrix are \code{0} except where edges are found. } \author{P. Shannon} \seealso{ \code{\link{edgeMatrix}} } \examples{ from <- c("a", "a", "a", "x", "x", "c") to <- c("b", "c", "x", "y", "c", "a") weight <- c(3.4, 2.6, 1.7, 5.3, 1.6, 7.9) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g1 <- graphBAM(df, edgemode = "directed") adjacencyMatrix(g1) } \keyword{manip } graph/man/toDotWithRI.Rd0000644000175000017500000000456314136046755014752 0ustar nileshnilesh\name{toDotWithRI} \alias{toDotWithRI} \title{Translate a graph to "dot" including rendering information} \usage{ toDotWithRI(graph, graph_name = NULL, subGraphList = list(), isStrict = TRUE) } \arguments{ \item{graph}{An object of graph \code{graph}} \item{graph_name}{The name of the graph} \item{subGraphList}{A list of objects of class \code{graph}. Each of these is used as a subgraph in the graph. The names in the list are taken as the names of the subgraph. If a graph is to be seen as a cluster (i.e. with a box around it), its name has to start with \code{cluster}.} \item{isStrict}{Should the graph be strict} } \value{ A character vector with the graph in dot format } \description{ The function takes a graph object and translates it into the dot format. All rendering information is written verbatim into the dot graph as well } \details{ Given a graph object, it is translated into the \code{dot} language so that it can be rendered using the \code{graphviz} software. In addition to plotting the graph itself, all the rendering information is being used as well. \code{graphRenderInfo} attributes are written as an attribute list after the \code{graph} statement in dot. \code{nodeRendenInfo} attributes are written as attribute lists after each node. If an attribute is constant across all node, a global node attribute is written instead of many individual ones.##' Newlines ##' in attributes do not lead to newlines in labels. In \code{label}, \code{headlabel} and \code{taillabel}, in order to get a newline, right justification or left justification, the two character sequences \code{\\n}, \code{\\r} and \code{\\l} have to be written (i.e. in order to create this in R, the backslash has to be escaped in a string, that is has to be written as a double-backslash). \code{edgeRenderInfo} attributes as written as attribute lists after each edge, unless an attribute is constant, then it is written as a global edge attribute. In general, all attribute values are being wrapped in double-quotes, unless the attibute value start with a \code{<} and ends with a \code{>}. In this case it is taken as html content and not wrapped in double quotes (nor are contained newlines escaped). The resulting graph in dot format is returned as a character vector. } \author{ Holger Hoefling \email{hhoeflin@gmail.com} }graph/man/graph-class.Rd0000644000175000017500000002274014136046755014773 0ustar nileshnilesh\name{graph-class} \docType{class} \alias{graph-class} \alias{graphBase-class} \alias{complement} \alias{complement,graph-method} \alias{connComp} \alias{connComp,graph-method} \alias{degree} \alias{degree,graph-method} \alias{degree,MultiGraph-method} \alias{dfs,graph-method} \alias{edgeDataDefaults<-,graph,missing,list-method} \alias{edgeDataDefaults<-,graph,character-method} \alias{edgeDataDefaults<-,graph,character,ANY-method} \alias{edgeDataDefaults,graph,missing-method} \alias{edgeDataDefaults,graph,character-method} \alias{edgeData<-,graph,character,character,character-method} \alias{edgeData<-,graph,character,missing,character-method} \alias{edgeData<-,graph,missing,character,character-method} \alias{edgeData<-,graph,character,character,character,ANY-method} \alias{edgeData<-,graph,character,missing,character,ANY-method} \alias{edgeData<-,graph,missing,character,character,ANY-method} \alias{edgeData,graph,character,character,character-method} \alias{edgeData,graph,character,character,missing-method} \alias{edgeData,graph,character,missing,character-method} \alias{edgeData,graph,missing,character,character-method} \alias{edgeData,graph,missing,missing,character-method} \alias{edgeData,graph,missing,missing,missing-method} \alias{edgemode} \alias{edgemode<-} \alias{edgemode,graph-method} \alias{edgemode<-,graph,character-method} \alias{edgeNames} \alias{edgeNames,graph-method} \alias{edgeL,graph-method} \alias{edgeWeights,graph,character-method} \alias{edgeWeights,graph,numeric-method} \alias{edgeWeights,graph,missing-method} \alias{intersection} \alias{intersection,graph,graph-method} \alias{intersection2} \alias{intersection2,graph,graph-method} \alias{isAdjacent,graph,character,character-method} \alias{isConnected} \alias{isConnected,graph-method} \alias{isDirected,graph-method} \alias{join} \alias{join,graph,graph-method} \alias{nodeDataDefaults<-,graph,missing,list-method} \alias{nodeDataDefaults<-,graph,character-method} \alias{nodeDataDefaults<-,graph,character,ANY-method} \alias{nodeDataDefaults,graph,missing-method} \alias{nodeDataDefaults,graph,character-method} \alias{nodeData<-,graph,character,character-method} \alias{nodeData<-,graph,missing,character-method} \alias{nodeData,graph,character,character-method} \alias{nodeData,graph,character,missing-method} \alias{nodeData,graph,missing,character-method} \alias{nodeData,graph,missing,missing-method} \alias{nodes,graph-method} \alias{nodes<-,graph,character-method} \alias{numEdges} \alias{numEdges,graph-method} \alias{numNodes} \alias{numNodes,graph-method} \alias{plot,graph,ANY-method} \alias{plot,graph-method} \alias{show,graph-method} \alias{union,graph,graph-method} \alias{updateGraph} \alias{updateGraph,graph-method} \title{Class "graph" } \description{A virtual class that all graph classes should extend. } \section{Objects from the Class}{ A virtual Class: No objects may be created from it. } \section{Slots}{ \describe{ \item{\code{edgeData}:}{An \code{attrData} instance for edge attributes.} \item{\code{nodeData}:}{An \code{attrData} instance for node attributes.} \item{\code{graphData}:}{A \code{list} for graph-level attributes. Only mandatory list item is \code{edgemode} which indicates whether edges are \code{"directed"} or \code{"undirected"}} \item{\code{renderInfo}:}{A \code{list} of graph rendering information.} } } \section{Methods}{ \describe{ \item{nodes}{return a character vector containing the names of the nodes of the graph} \item{nodes<-}{rename the nodes of the graph} \item{show}{\code{signature(object = "graph")}:A print method for the graph.} \item{acc}{\code{signature(object = "graph")}: find all nodes accessible from the specified node. } \item{complement}{\code{signature(x = "graph")}: compute the complement of the supplied graph. The complement is defined with respect to the complete graph on the nodes in \code{x}. Currently this returns an object of class \code{graphNEL}.} \item{connComp}{\code{signature(object = "graph")}: find the connected components of a graph.} \item{degree}{\code{signature(object = "graph")}: find the \code{degree} of a node (number of coincident edges).} \item{degree}{\code{signature(object = "MultiGraph")}: find the \code{degree} of a node (number of coincident edges).} \item{dfs}{\code{signature(object = "graph")}: execute a depth first search on a graph starting with the specified node.} \item{edges}{\code{signature(object="graph", which="character")}: return the edges indicated by \code{which}. \code{which} can be missing in which case all edges are returned or it can be a character vector with the node labels indicating the nodes whose edge lists are wanted.} \item{edgeDataDefaults}{Get and set default attributes for the edges in the graph.} \item{edgeData}{Get and set attributes for edges in the graph} \item{edgemode}{\code{signature(object="graph")}: return the \code{edgemode} for the graph. Currently this can be either \code{directed} or \code{undirected}.} \item{edgemode<-}{\code{signature(object="graph", value="character")}: set the \code{edgemode} for the graph. Currently this can be either \code{directed} or \code{undirected}.} \item{edgeWeights}{Return a list of edge weights in a list format similar to the \code{edges} method.} \item{intersection}{\code{signature(x = "graph", y = "graph")}: compute the intersection of the two supplied graphs. They must have identical nodes. Currently this returns an object of class \code{graphNEL}. With edge weights of 1 for any matching edge.} \item{isAdjacent}{\code{signature(from="character", to="character")}: Determine if edges exists between nodes.} \item{isConnected}{\code{signature(object = "graph")}: A boolean that details if a graph is fully connected or not.} \item{isDirected}{Return \code{TRUE} if the graph object has directed edges and \code{FALSE} otherwise.} \item{join}{\code{signature(x = "graph", y = "graph")}: returns the joining of two graphs. Nodes which are shared by both graphs will have their edges merged. Note that edgeWeights for the resulting graph are all set to 1. Users wishing to preserve weights in a join operation must perform addEdge operations on the resulting graph to restore weights.} \item{nodes<-}{A generic function that allows different implementations of the \code{graph} class to reset the node labels} \item{nodeDataDefaults}{Get/set default attributes for nodes in the graph.} \item{nodeData}{Get/set attributes for nodes in the graph.} \item{numEdges}{\code{signature(object = "graph")}: compute the number of edges in a graph.} \item{numNodes}{\code{signature(object = "graph")}: compute the number of nodes in a graph. } \item{plot}{Please see the help page for the \code{plot,graph-method} method in the \code{Rgraphviz} package} \item{union}{\code{signature(x = "graph", y = "graph")}: compute the union of the two supplied graphs. They must have identical nodes. Currently this returns an object of class \code{graphNEL}.} \item{edgeNames}{\code{signature(object = "graph")}: Returns a vector of the edge names for this graph, using the format \code{tail\~head}, where \code{head} is the name of the tail node and \code{head} is the name of the head node.} \item{updateGraph}{\code{signature(object = "graph")}: Updates old instances of graph objects.} } } \details{ \code{degree} returns either a named vector (names correspond to the nodes in the graph) containing the degree for undirected graphs or a list with two components, \code{inDegree} and \code{outDegree} for directed graphs. \code{connComp} returns a list of the connected components. Each element of this list contains the labels of all nodes in that component. For a \emph{directed graph} or \emph{digraph} the \dfn{underlying graph} is the graph that results from removing all direction from the edges. This can be achieved using the function \code{\link{ugraph}}. A \dfn{weakly connected} component of a \emph{digraph} is one that is a connected component of the underlying graph. This is the default for \code{connComp}. A \emph{digraph} is \dfn{strongly connected} if every two vertices are mutually reachable. A \dfn{strongly connected} component of a \emph{digraph}, \strong{D}, is a maximal \emph{strongly connected} subdigraph of \strong{D}. See the \pkg{RBGL} package for an implementation of Trajan's algorithm to find \emph{strongly connected} components (\code{\link[RBGL]{strongComp}}). In the \pkg{graph} implementation of \code{connComp} \emph{weak connectivity} is used. If the argument to \code{connComp} is a directed graph then \code{\link{ugraph}} is called to create the underlying undirected graph and that is used to compute connected components. Users who want different behavior are encouraged to use \pkg{RBGL}. } \references{ Graph Theory and its Applications, J. Gross and J. Yellen. } \author{R. Gentleman and E. Whalen. } \seealso{\code{\link{graphNEL-class}}, \code{\link{graphAM-class}}, \code{\link{distGraph-class}}. } \examples{ set.seed(123) g1 <- randomGraph(letters[1:10], 1:4, p= 0.3) numEdges(g1) edgeNames(g1) edges(g1) edges(g1, c("a","d")) # those incident to 'a' or 'd' } \keyword{graphs} \keyword{classes} graph/man/graphAM-class.Rd0000644000175000017500000001225414136046755015210 0ustar nileshnilesh\name{graphAM-class} \docType{class} \alias{graphAM-class} \alias{graphAM} \alias{addEdge,character,character,graphAM,missing-method} \alias{addNode,character,graphAM,missing-method} \alias{clearNode,character,graphAM-method} \alias{coerce,graphAM,graphNEL-method} \alias{coerce,graphAM,matrix-method} \alias{coerce,matrix,graphAM-method} \alias{coerce,graphAM,graphBAM-method} \alias{edges,graphAM-method} \alias{initialize,graphAM-method} \alias{inEdges,missing,graphAM-method} \alias{inEdges,character,graphAM-method} \alias{inEdges,graphAM,missing-method} \alias{isAdjacent,graphAM,character,character-method} \alias{nodes<-,graphAM,character-method} \alias{nodes,graphAM-method} \alias{numEdges,graphAM-method} \alias{numNodes,graphAM-method} \alias{removeEdge,character,character,graphAM-method} \alias{removeNode,character,graphAM-method} \title{Class "graphAM"} \description{ A graph class where node and edge information is represented as an adjacency matrix. The adjacency matrix is square and element \code{adjMat[i, j]} is one if there is an edge from node i to node j and zero otherwise. } \details{ The non-zero matrix values can be used to initialize an edge attribute. If this is desired, use the \code{values} argument in the call to \code{new} and provide a list with a single named element. The name determines the attributes and the value provides the default value for that attribute. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{graphAM(adjMat, edgemode, values)}. } \section{Slots}{ \describe{ \item{\code{adjMat}:}{An adjacency \code{"matrix"} describing the graph structure. The \code{\link{colnames}} of the matrix will be used as node names for the graph if present.} \item{\code{edgeData}:}{Storage for edge attributes.} \item{\code{nodeData}:}{Storage for node attributes.} } } \section{Extends}{ Class \code{"graph"}, directly. } \section{Constructor}{ \code{graphAM(adjMat=matrix(integer(), 0, 0), edgemode='undirected', values=NA)} creates a graphAM instance. \describe{ \item{adjMat}{An \code{integer} matrix specifying which nodes have edges between them.} \item{edgemode}{Either "directed" or "undirected".} \item{values}{A named list of length 1, used (rather obscurely) to specify that non-zero adjMat values initialize an edge attribute. The name of the single element in that list becomes the name of that attribute, with the specified default value. This default value is, however, never used: the specified edge attribute always has the value contained in the adjacency matrix, which is traditionally 1, but can be any positive number.} } } \section{Methods}{ \describe{ \item{addEdge}{\code{signature(from = "character", to = "character", graph = "graphAM", weights = "missing")}: ... } \item{addNode}{\code{signature(object = "graphAM", nodes = "character")}: ... } \item{clearNode}{\code{signature(node = "character", object = "graphAM")}: ... } \item{coerce}{\code{signature(from = "graphAM", to = "graphNEL")}: ... } \item{coerce}{\code{signature(from = "graphAM", to = "graphBAM")}: ... } \item{coerce}{\code{signature(from = "graphAM", to = "matrix")}: In converting to a \code{matrix}, if an edge attribute named \code{"weight"} is defined, the non-zero elements of the matrix will contain the corresponding attribute value. For more flexible matrix conversion, see \code{toMatrix}.} \item{coerce}{\code{signature(from = "matrix", to = "graphAM")}: This coerce method exists for symmetry. In most cases, creating a new \code{graphAM} instance using \code{new} gives one more control over the resulting graph.} \item{edges}{\code{signature(object = "graphAM")}: ... } \item{initialize}{\code{signature(.Object = "graphAM")}: ... } \item{inEdges}{\code{signature(node = "character", object = "graphNEL")}: Return the incoming edges for the specified nodes. See \code{\link{inEdges}}.} \item{isAdjacent}{\code{signature(object = "graphAM", from = "character", to = "character")}: ... } \item{nodes<-}{\code{signature(object = "graphAM", value = "character")}: ... } \item{nodes}{\code{signature(object = "graphAM")}: ... } \item{numEdges}{\code{signature(graph = "graphAM")}: ... } \item{numNodes}{\code{signature(object = "graphAM")}: ... } \item{removeEdge}{\code{signature(from = "character", to = "character", graph = "graphAM")}: ... } \item{removeNode}{\code{signature(node = "character", object = "graphAM")}: ... } } } \author{Seth Falcon} \seealso{ \code{\link{graph-class}}, \code{\link{graphNEL-class}} } \examples{ mat <- rbind(c(0, 0, 1, 1), c(0, 0, 1, 1), c(1, 1, 0, 1), c(1, 1, 1, 0)) rownames(mat) <- colnames(mat) <- letters[1:4] g1 <- graphAM(adjMat=mat) stopifnot(identical(mat, as(g1, "matrix")), validObject(g1)) ## now with weights: mat[1,3] <- mat[3,1] <- 10 gw <- graphAM(adjMat=mat, values=list(weight=1)) ## consistency check: stopifnot(identical(mat, as(gw, "matrix")), validObject(gw), identical(gw, as(as(gw, "graphNEL"), "graphAM"))) } \keyword{graphs} \keyword{classes} graph/man/biocRepos.Rd0000644000175000017500000000073214136046755014511 0ustar nileshnilesh\name{biocRepos} \alias{biocRepos} \docType{data} \title{A graph representing the Bioconductor package repository} \description{ This graph is a rendition of the Bioconductor package repository and represents the dependency graph of that repository. An edge between two package denotes a dependency on the 'to' package by the 'from' package. } \usage{data(biocRepos)} \examples{ data(biocRepos) ## An example of usage will be here soon } \keyword{datasets} graph/src/0000755000175000017500000000000014136072220012271 5ustar nileshnileshgraph/src/graph.c0000644000175000017500000007235414136046755013567 0ustar nileshnilesh#include #include #include #include SEXP R_scalarString(const char *); SEXP intersectStrings(SEXP, SEXP); SEXP graph_intersection(SEXP, SEXP, SEXP, SEXP, SEXP); SEXP checkEdgeList(SEXP, SEXP); SEXP graph_listLen(SEXP); SEXP graph_attrData_lookup(SEXP attrObj, SEXP keys, SEXP attr); SEXP graph_sublist_assign(SEXP x, SEXP subs, SEXP sublist, SEXP values); SEXP graph_is_adjacent(SEXP fromEdges, SEXP to); SEXP graph_bitarray_sum(SEXP bits); SEXP graph_bitarray_set(SEXP bits, SEXP idx, SEXP val); SEXP graph_bitarray_transpose(SEXP bits); SEXP graph_bitarray_undirect(SEXP bits); SEXP graph_bitarray_rowColPos(SEXP bits); SEXP graph_bitarray_subGraph(SEXP bits, SEXP _subIndx); SEXP graph_bitarray_edgeSetToMatrix(SEXP nodes, SEXP bits, SEXP _weights, SEXP _directed); SEXP graph_bitarray_getBitCell(SEXP bits, SEXP _from, SEXP _to); SEXP graph_bitarray_Union_Attrs(SEXP inputBits, SEXP cmnBits, SEXP fromOneBits, SEXP fromTwoBits); SEXP graph_bitarray_Interect_Attrs(SEXP cmnBits, SEXP fromOneBits, SEXP fromTwoBits); SEXP graph_bitarray_removeEdges(SEXP bits, SEXP _indx); SEXP graph_bitarray_getEdgeAttrOrder(SEXP , SEXP , SEXP ); //SEXP graph_bitarray_getEdgeAttrPos(SEXP origBits, SEXP newBits) ; # define graph_duplicated(x) Rf_duplicated(x, FALSE) static const R_CallMethodDef R_CallDef[] = { {"intersectStrings", (DL_FUNC)&intersectStrings, 2}, {"graph_intersection", (DL_FUNC)&graph_intersection, 5}, {"graph_listLen", (DL_FUNC)&graph_listLen, 1}, {"graph_attrData_lookup", (DL_FUNC)&graph_attrData_lookup, 3}, {"graph_sublist_assign", (DL_FUNC)&graph_sublist_assign, 4}, {"graph_is_adjacent", (DL_FUNC)&graph_is_adjacent, 2}, {"graph_bitarray_rowColPos", (DL_FUNC)&graph_bitarray_rowColPos, 1}, {"graph_bitarray_getEdgeAttrOrder", (DL_FUNC)&graph_bitarray_getEdgeAttrOrder, 3}, {NULL, NULL, 0}, }; void R_init_BioC_graph(DllInfo *info) { R_registerRoutines(info, NULL, R_CallDef, NULL, NULL); } SEXP R_scalarString(const char *v) { SEXP ans = allocVector(STRSXP, 1); PROTECT(ans); if(v) SET_STRING_ELT(ans, 0, mkChar(v)); UNPROTECT(1); return(ans); } SEXP intersectStrings(SEXP x, SEXP y) { SEXP ans, matchRes, matched, dup; int i, j, k, n, numZero=0, size; int curEntry=0; PROTECT(matchRes = Rf_match(y, x, 0)); for (i = 0; i < length(matchRes); i++) { if (INTEGER(matchRes)[i] == 0) numZero++; } size = length(matchRes) - numZero; PROTECT(matched = allocVector(STRSXP, size)); for (i = 0; i < length(matchRes); i++) { if (INTEGER(matchRes)[i] != 0) { SET_STRING_ELT(matched, curEntry++, STRING_ELT(y, INTEGER(matchRes)[i]-1)); } } PROTECT(dup = graph_duplicated(matched)); n = length(matched); k = 0; for (j = 0; j < n; j++) if (LOGICAL(dup)[j] == 0) k++; PROTECT(ans = allocVector(STRSXP, k)); k = 0; for (j = 0; j < n; j++) { if (LOGICAL(dup)[j] == 0) { SET_STRING_ELT(ans, k++, STRING_ELT(matched, j)); } } UNPROTECT(4); return(ans); } SEXP graph_intersection(SEXP xN, SEXP yN, SEXP xE, SEXP yE, SEXP edgeMode) { /* edgeMode == 0 implies "undirected" */ SEXP bN, newXE, newYE; SEXP klass, outGraph; SEXP rval, ans, curRval, curWeights, curEdges, newNames, matches; int i, j, curEle=0; klass = MAKE_CLASS("graphNEL"); PROTECT(outGraph = NEW_OBJECT(klass)); if (INTEGER(edgeMode)[0]) SET_SLOT(outGraph, Rf_install("edgemode"), R_scalarString("directed")); else SET_SLOT(outGraph, Rf_install("edgemode"), R_scalarString("undirected")); PROTECT(bN = intersectStrings(xN, yN)); if (length(bN) == 0) { SET_SLOT(outGraph, Rf_install("nodes"), allocVector(STRSXP, 0)); SET_SLOT(outGraph, Rf_install("edgeL"), allocVector(VECSXP, 0)); UNPROTECT(1); return(outGraph); } PROTECT(newXE = checkEdgeList(xE, bN)); PROTECT(newYE = checkEdgeList(yE, bN)); PROTECT(newNames = allocVector(STRSXP, 2)); SET_STRING_ELT(newNames, 0, mkChar("edges")); SET_STRING_ELT(newNames, 1, mkChar("weights")); PROTECT(rval = allocVector(VECSXP, length(newXE))); for (i = 0; i < length(newXE); i++) { PROTECT(curRval = allocVector(VECSXP, 2)); setAttrib(curRval, R_NamesSymbol, newNames); PROTECT(ans = intersectStrings(VECTOR_ELT(newXE, i), VECTOR_ELT(newYE, i))); if (length(ans) == 0) { SET_VECTOR_ELT(curRval, 0, allocVector(INTSXP, 0)); SET_VECTOR_ELT(curRval, 1, allocVector(INTSXP, 0)); } else { PROTECT(curEdges = allocVector(INTSXP, length(ans))); PROTECT(matches = Rf_match(bN, ans, 0)); curEle = 0; for (j = 0; j < length(matches); j++) { if (INTEGER(matches)[j] != 0) INTEGER(curEdges)[curEle++] = INTEGER(matches)[j]; } SET_VECTOR_ELT(curRval, 0, curEdges); PROTECT(curWeights = allocVector(INTSXP, length(ans))); for (j = 0; j < length(ans); j++) INTEGER(curWeights)[j] = 1; SET_VECTOR_ELT(curRval, 1, curWeights); UNPROTECT(3); } SET_VECTOR_ELT(rval, i, curRval); UNPROTECT(2); } setAttrib(rval, R_NamesSymbol, bN); SET_SLOT(outGraph, Rf_install("nodes"), bN); SET_SLOT(outGraph, Rf_install("edgeL"), rval); UNPROTECT(6); return(outGraph); } SEXP checkEdgeList(SEXP eL, SEXP bN) { SEXP newEL, curVec, curMatches, newVec, eleNames; int i, j, k, size, curEle; PROTECT(newEL = allocVector(VECSXP, length(bN))); PROTECT(eleNames = getAttrib(eL, R_NamesSymbol)); for (i = 0; i < length(bN); i++) { for (k = 0; k < length(eL); k++) { if (strcmp(CHAR(STRING_ELT(eleNames, k)), CHAR(STRING_ELT(bN, i))) == 0) break; } if (k < length(eL)) { curVec = VECTOR_ELT(eL, k); PROTECT(curMatches = Rf_match(curVec, bN, 0)); size = length(curMatches); for (j = 0; j < length(curMatches); j++) { if (INTEGER(curMatches)[j] == 0) size--; } PROTECT(newVec = allocVector(STRSXP, size)); curEle = 0; for (j = 0; j < length(curMatches); j++) { if (INTEGER(curMatches)[j] != 0) { SET_STRING_ELT(newVec, curEle++, STRING_ELT(curVec, INTEGER(curMatches)[j]-1)); } } SET_VECTOR_ELT(newEL, i, newVec); UNPROTECT(2); } } setAttrib(newEL, R_NamesSymbol, bN); UNPROTECT(2); return(newEL); } /* Taken from Biobase to avoid depending on it */ SEXP graph_listLen(SEXP x) { SEXP ans; int i; if( !Rf_isNewList(x) ) error("require a list"); PROTECT(ans = allocVector(REALSXP, length(x))); for(i=0; i 1 && ns != numVals) error("invalid args: subs and values must be the same length"); names = GET_NAMES(x); PROTECT(idx = match(names, subs, -1)); PROTECT(newsubs = allocVector(STRSXP, ns)); nnew = 0; for (i = 0; i < ns; i++) { if (INTEGER(idx)[i] == -1) SET_STRING_ELT(newsubs, nnew++, STRING_ELT(subs, i)); } PROTECT(ans = allocVector(VECSXP, origlen + nnew)); PROTECT(ansnames = allocVector(STRSXP, length(ans))); for (i = 0; i < origlen; i++) { SET_VECTOR_ELT(ans, i, duplicate(VECTOR_ELT(x, i))); SET_STRING_ELT(ansnames, i, duplicate(STRING_ELT(names, i))); } j = origlen; for (i = 0; i < nnew; i++) SET_STRING_ELT(ansnames, j++, STRING_ELT(newsubs, i)); SET_NAMES(ans, ansnames); UNPROTECT(1); nextempty = origlen; /* index of next unfilled element of ans */ for (i = 0; i < ns; i++) { if (numVals > 1) PROTECT(val = graph_makeItem(values, i)); else if (numVals == 1 && isVectorList(values)) PROTECT(val = duplicate(VECTOR_ELT(values, 0))); else PROTECT(val = duplicate(values)); j = INTEGER(idx)[i]; if (j < 0) { tmpItem = graph_addItemToList(R_NilValue, val, sublist); SET_VECTOR_ELT(ans, nextempty, tmpItem); nextempty++; } else { tmpItem = VECTOR_ELT(ans, j-1); tmpIdx = graph_getListIndex(tmpItem, sublist); if (tmpIdx == -1) { tmpItem = graph_addItemToList(tmpItem, val, sublist); SET_VECTOR_ELT(ans, j-1, tmpItem); } else SET_VECTOR_ELT(tmpItem, tmpIdx, val); } UNPROTECT(1); } UNPROTECT(3); return ans; } SEXP graph_is_adjacent(SEXP fromEdges, SEXP to) { SEXP ans, frEdges, toEdge, idx; int i, j, lenTo; int found = 0; lenTo = length(to); PROTECT(ans = allocVector(LGLSXP, lenTo)); for (i = 0; i < lenTo; i++) { found = 0; PROTECT(toEdge = ScalarString(STRING_ELT(to, i))); frEdges = VECTOR_ELT(fromEdges, i); idx = match(toEdge, frEdges, 0); for (j = 0; j < length(idx); j++) if ((found = (INTEGER(idx)[j] > 0))) break; LOGICAL(ans)[i] = found; UNPROTECT(1); } UNPROTECT(1); return ans; } SEXP graph_bitarray_sum(SEXP bits) { /* This approach from http://graphics.stanford.edu/~seander/bithacks.html#CountBitsSetKernighan */ unsigned char *bytes = (unsigned char *) RAW(bits); unsigned char v; int c = 0; int len = length(bits); int i; for (i = 0; i < len; i++) { for (v = bytes[i]; v; c++) { v &= v - 1; /* clear the least significant bit set */ } } return ScalarInteger(c); } SEXP graph_bitarray_rowColPos(SEXP bits) { SEXP ans, matDim, dimNames, colNames; int i, j = 0, k, len = length(bits), *indices, dim = asInteger(getAttrib(bits, install("bitdim"))), edgeCount = asInteger(getAttrib(bits, install("nbitset"))); unsigned char v, *bytes = (unsigned char *) RAW(bits); PROTECT(ans = allocVector(INTSXP, 2 * edgeCount)); indices = INTEGER(ans); for (i = 0; i < len; i++) { for (v = bytes[i], k = 0; v; v >>= 1, k++) { if (v & 1) { int idx = (i * 8) + k; indices[j] = (idx % dim) + 1; /* R is 1-based */ indices[j + edgeCount] = (idx / dim) + 1; j++; } } } PROTECT(matDim = allocVector(INTSXP, 2)); INTEGER(matDim)[0] = edgeCount; INTEGER(matDim)[1] = 2; setAttrib(ans, R_DimSymbol, matDim); PROTECT(colNames = allocVector(STRSXP, 2)); SET_STRING_ELT(colNames, 0, mkChar("from")); SET_STRING_ELT(colNames, 1, mkChar("to")); PROTECT(dimNames = allocVector(VECSXP, 2)); SET_VECTOR_ELT(dimNames, 0, R_NilValue); SET_VECTOR_ELT(dimNames, 1, colNames); setAttrib(ans, R_DimNamesSymbol, dimNames); UNPROTECT(4); return ans; } #define COORD_TO_INDEX(x, y, nrow) ((((y)+1) * (nrow)) - ((nrow) - ((x)+1)) - 1) #define NROW(x) (INTEGER(getAttrib((x), install("bitdim")))[0]) #define INDEX_TO_ROW(i, n) ((i) % (n)) #define INDEX_TO_COL(i, n) ((i) / (n)) #define IS_SET(b, i, bit) ((b)[i] != 0 && ((b)[i] & (1 << (bit)))) SEXP graph_bitarray_transpose(SEXP bits) { SEXP ans; int nrow, i, j, len = length(bits); unsigned char *bytes = RAW(bits), *ans_bytes; ans = PROTECT(duplicate(bits)); /* dup to capture attributes */ ans_bytes = RAW(ans); memset(ans_bytes, 0, len); nrow = NROW(bits); /* FIXME: use a single loop, look at R's array.c */ for (i = 0; i < nrow; i++) { for (j = 0; j < nrow; j++) { int idx = COORD_TO_INDEX(i, j, nrow), tidx = COORD_TO_INDEX(j, i, nrow); int byteIndex = idx / 8, bitIndex = idx % 8, tBitIndex = tidx % 8; if (IS_SET(bytes, byteIndex, bitIndex)) ans_bytes[tidx / 8] |= (1 << tBitIndex); } } UNPROTECT(1); return ans; } /* Given a bit vector representing directed edges, return a new bit vector with the underlying undirected edges. */ SEXP graph_bitarray_undirect(SEXP bits) { int i, j, c = 0, len = length(bits), nrow = NROW(bits); SEXP tbits = PROTECT(graph_bitarray_transpose(bits)), ans = PROTECT(duplicate(bits)); unsigned char *bytes = RAW(bits), *tbytes = RAW(tbits), *abytes = RAW(ans); for (i = 0; i < len; i++) { unsigned char v; if (0 != (abytes[i] = bytes[i] | tbytes[i])) { /* keep track of edge count */ for (v = abytes[i]; v; c++) { v &= v - 1; /* clear the least significant bit set */ } } } /* zero out lower tri */ for (i = 0; i < nrow; i++) { for (j = 0; j < nrow; j++) { if (i > j) { unsigned char v; int idx = COORD_TO_INDEX(i, j, nrow); v = abytes[idx / 8]; if (0 != v) { if (IS_SET(abytes, idx / 8, idx % 8)) c--; abytes[idx / 8] &= ~(1 << (idx % 8)); } } } } INTEGER(getAttrib(ans, install("nbitset")))[0] = c; UNPROTECT(2); return ans; } SEXP graph_bitarray_set(SEXP bits, SEXP idx, SEXP val) { SEXP ans = PROTECT(duplicate(bits)); int *which, *values, i, nVal = length(val), *num_set = INTEGER(getAttrib(ans, install("nbitset"))); unsigned char *bytes = RAW(ans); PROTECT(idx = coerceVector(idx, INTSXP)); PROTECT(val = coerceVector(val, INTSXP)); which = INTEGER(idx); values = INTEGER(val); for (i = 0; i < nVal; i++) { int w = which[i] - 1; int offset = w / 8; unsigned char bit = w % 8; if (values[i]) { if (!IS_SET(bytes, offset, bit)) (*num_set)++; bytes[offset] |= (1 << bit); } else { if (IS_SET(bytes, offset, bit)) (*num_set)--; bytes[offset] &= ~(1 << bit); } } UNPROTECT(3); return ans; } SEXP graph_bitarray_subGraph(SEXP bits, SEXP _subIndx) { SEXP _dim = getAttrib(bits,install("bitdim")), sgVec, btlen, btdim, btcnt, _ftSetPos, res, namesres; int dim, subLen, prevSetPos = 0, sgSetIndx = 0, linIndx = 0, col, subgBitLen, subgBytes, *subIndx, *ftSetPos, edgeCount = 0, ftLen = 256; PROTECT_INDEX pidx; unsigned char *bytes = (unsigned char *) RAW(bits), *sgBits; dim = INTEGER(_dim)[0]; subIndx = INTEGER(_subIndx); subLen = length(_subIndx); subgBitLen = subLen * subLen; subgBytes = subgBitLen / 8; if ((subgBitLen % 8) != 0) { subgBytes++; } PROTECT(sgVec = allocVector(RAWSXP, subgBytes)); sgBits = RAW(sgVec); memset(sgBits, 0, subgBytes); /* TODO: in many cases, this will be more than we need, we should also use the number of edges in the input as a starting point. */ _ftSetPos = allocVector(INTSXP, ftLen); /* FIXME: need better guess */ PROTECT_WITH_INDEX(_ftSetPos, &pidx); ftSetPos = INTEGER(_ftSetPos); for (col = 0; col < subLen; col++) { int col_idx_dim = ((subIndx[col] - 1) * dim) - 1; int row = 0; while (row < subLen) { int setPos = col_idx_dim + subIndx[row]; unsigned char v = bytes[setPos / 8]; if (v != 0 && v & (1 << (setPos % 8))) { int curSetPos = setPos, m = prevSetPos; while (m < curSetPos) { unsigned char tempV = bytes[m / 8]; if (tempV == 0) { m += 8; } else { if (tempV & (1 << (m % 8))) edgeCount++; m++; } } prevSetPos = curSetPos + 1; edgeCount++; /* current edge */ if (sgSetIndx == ftLen) { ftLen *= 2; if (ftLen > subgBitLen) ftLen = subgBitLen; REPROTECT(_ftSetPos = lengthgets(_ftSetPos, ftLen), pidx); ftSetPos = INTEGER(_ftSetPos); } ftSetPos[sgSetIndx] = edgeCount; sgSetIndx++; sgBits[linIndx / 8] |= (1 << (linIndx % 8)); } linIndx++; row++; } } REPROTECT(_ftSetPos = lengthgets(_ftSetPos, sgSetIndx), pidx); PROTECT(btlen = ScalarInteger(subgBitLen)); PROTECT(btcnt = ScalarInteger(sgSetIndx)); PROTECT(btdim = allocVector(INTSXP, 2)); INTEGER(btdim)[0] = subLen; INTEGER(btdim)[1] = subLen; setAttrib(sgVec, install("bitlen"), btlen); setAttrib(sgVec, install("bitdim"), btdim); setAttrib(sgVec, install("nbitset"), btcnt); PROTECT(res = allocVector(VECSXP, 2)); SET_VECTOR_ELT(res, 0, _ftSetPos); SET_VECTOR_ELT(res, 1, sgVec); PROTECT(namesres = allocVector(STRSXP, 2)); SET_STRING_ELT(namesres, 0, mkChar("setPos")); SET_STRING_ELT(namesres, 1, mkChar("bitVec")); setAttrib(res, R_NamesSymbol, namesres); UNPROTECT(7); return res; } SEXP graph_bitarray_edgeSetToMatrix(SEXP nodes, SEXP bits, SEXP _weights, SEXP _directed) { SEXP ans, dnms, _dim = getAttrib(bits, install("bitdim")); unsigned char *bytes = (unsigned char *) RAW(bits); int dim = INTEGER(_dim)[0], num_el = dim * dim, directed = asInteger(_directed), linIndx = 0, wtIndx = 0; double *weights = REAL(_weights), *ftMat; PROTECT(ans = allocVector(REALSXP, num_el)); ftMat = REAL(ans); memset(ftMat, 0, sizeof(double) * num_el); while (linIndx < num_el) { unsigned char v = bytes[linIndx / 8]; if (v == 0) { linIndx += 8; } else { if (v & (1 << (linIndx % 8))) { ftMat[linIndx] = weights[wtIndx]; if (!directed) { ftMat[linIndx/dim + (linIndx % dim)*dim] = weights[wtIndx]; } wtIndx++; } linIndx++; } } MARK_NOT_MUTABLE(_dim); setAttrib(ans, R_DimSymbol, _dim); PROTECT(dnms = allocVector(VECSXP, 2)); /* Arguments to .Call are marked as not mutable, so we can reuse here. */ SET_VECTOR_ELT(dnms, 0, nodes); SET_VECTOR_ELT(dnms, 1, nodes); setAttrib(ans, R_DimNamesSymbol, dnms); UNPROTECT(2); return ans; } SEXP graph_bitarray_getBitCell(SEXP bits, SEXP _from, SEXP _to) { int len = length(_to); SEXP ans; PROTECT(ans = allocVector(LGLSXP, len)); unsigned char *bytes = (unsigned char *) RAW(bits); int *from = INTEGER(_from); int *to = INTEGER(_to); int dim = NROW(bits); int i = 0, val, byteIndex, bitIndex, indx; for(i =0; i < len; i++) { indx = COORD_TO_INDEX(from[i]-1, to[i]-1, dim) ; byteIndex = indx / 8 ; bitIndex = indx % 8 ; val = bytes[byteIndex] & (1 << bitIndex); LOGICAL(ans)[i] = 0; if (val) { LOGICAL(ans)[i] = 1; } } UNPROTECT(1); return(ans); } SEXP graph_bitarray_Union_Attrs(SEXP inputBits, SEXP cmnBits, SEXP fromOneBits, SEXP fromTwoBits) { unsigned char *ans = (unsigned char*) RAW(inputBits); unsigned char *cmn = (unsigned char*) RAW(cmnBits); unsigned char *fromOne = (unsigned char *) RAW(fromOneBits); unsigned char *fromTwo = (unsigned char *) RAW(fromTwoBits); int len = length(inputBits) * 8; int i, byteIndex, bitIndex , shft, setIndx = 0; int nn = asInteger(getAttrib(inputBits, install("nbitset"))); SEXP from, indx1, indx2, res, namesres ; PROTECT(from = allocVector(INTSXP, nn)); PROTECT(indx1 = allocVector(INTSXP , nn)); PROTECT(indx2 = allocVector(INTSXP , nn)); int from1Indx = 0; int from2Indx = 0; int cmnIndx = 0; for( i =0 ; i < len; i ++) { byteIndex = i / 8; bitIndex = i % 8; shft = 1 << bitIndex; if(ans[byteIndex] & (shft)) { if(cmn [byteIndex] & (shft)) { cmnIndx++; from1Indx++; from2Indx++; INTEGER(from)[setIndx] = 0; } else if(fromOne[byteIndex] & (shft)) { from1Indx++; INTEGER(from)[setIndx] = 1; } else if(fromTwo[byteIndex] & (shft)) { from2Indx++; INTEGER(from)[setIndx] = 2; } INTEGER(indx1)[setIndx] = from1Indx ; INTEGER(indx2)[setIndx] = from2Indx; setIndx++; } } PROTECT(res = allocVector(VECSXP, 3)); SET_VECTOR_ELT(res, 0, from); SET_VECTOR_ELT(res, 1, indx1); SET_VECTOR_ELT(res, 2, indx2); PROTECT(namesres = allocVector(STRSXP, 3)); SET_STRING_ELT(namesres, 0, mkChar("from")); SET_STRING_ELT(namesres, 1, mkChar("indx1")); SET_STRING_ELT(namesres, 2, mkChar("indx2")); setAttrib(res, R_NamesSymbol, namesres); UNPROTECT(5); return(res); } SEXP graph_bitarray_Intersect_Attrs(SEXP cmnBits, SEXP fromOneBits, SEXP fromTwoBits) { unsigned char *cmn = (unsigned char*) RAW(cmnBits); unsigned char *fromOne = (unsigned char *) RAW(fromOneBits); unsigned char *fromTwo = (unsigned char *) RAW(fromTwoBits); int len = length(cmnBits) * 8; int i, byteIndex, bitIndex , shft, setIndx = 0; int nn = asInteger(getAttrib(cmnBits, install("nbitset"))); SEXP from, indx1, indx2, res, namesres; PROTECT(from = allocVector(INTSXP, nn)); PROTECT(indx1 = allocVector(INTSXP , nn)); PROTECT(indx2 = allocVector(INTSXP , nn)); int from1Indx = 0; int from2Indx = 0; for( i =0 ; i < len; i ++) { byteIndex = i / 8; bitIndex = i % 8; shft = 1 << bitIndex; if(fromOne[byteIndex] & (shft) ) { from1Indx++; } if(fromTwo[byteIndex] & (shft)) { from2Indx++; } if(cmn[byteIndex] & (shft)) { INTEGER(from)[setIndx] = 0; INTEGER(indx1)[setIndx] = from1Indx; INTEGER(indx2)[setIndx] = from2Indx; setIndx++; } } PROTECT(res = allocVector(VECSXP, 3)); SET_VECTOR_ELT(res, 0, from); SET_VECTOR_ELT(res, 1, indx1); SET_VECTOR_ELT(res, 2, indx2); PROTECT(namesres = allocVector(STRSXP, 3)); SET_STRING_ELT(namesres, 0, mkChar("from")); SET_STRING_ELT(namesres, 1, mkChar("indx1")); SET_STRING_ELT(namesres, 2, mkChar("indx2")); setAttrib(res, R_NamesSymbol, namesres); UNPROTECT(5); return(res); } SEXP graph_bitarray_removeEdges(SEXP bits, SEXP _indx) { SEXP ans = PROTECT(duplicate(bits)), btcnt; unsigned char *bytes = (unsigned char *) RAW(ans); int *indx = INTEGER(_indx); int len = length(bits) * 8 ; int i, byteIndex, bitIndex, subIndx =0; int nSet = 0; unsigned char mask; for( i =0 ; i < len; i ++) { byteIndex = i / 8; bitIndex = i % 8; if(IS_SET(bytes, byteIndex, bitIndex)) { if(indx[subIndx] == 0){ mask = ~(1 << bitIndex) ; bytes[byteIndex] = bytes[byteIndex] & mask; } else { nSet++; } subIndx++; } } PROTECT(btcnt = ScalarInteger(nSet)); setAttrib(ans, install("nbitset"), btcnt); UNPROTECT(2); return(ans); } SEXP graph_bitarray_getEdgeAttrOrder(SEXP _bits, SEXP _from, SEXP _to) { unsigned char *bits = (unsigned char*) RAW(_bits); int ns = asInteger(getAttrib(_bits, install("nbitset"))); int len = length(_from); int *from = INTEGER(_from); int *to = INTEGER(_to); int dim = NROW(_bits); int byteIndex, bitIndex, shft, indx, intIndx, i, j; int oindx=0, nindx=0, attrIndx=0, setCount=0; SEXP origRightPos, origLeftPos, newRightPos, newLeftPos, res, namesres; PROTECT(origRightPos = allocVector(INTSXP, ns)); //index into orig attr PROTECT(origLeftPos = allocVector(INTSXP, ns)); PROTECT(newRightPos = allocVector(INTSXP, len)); PROTECT(newLeftPos = allocVector(INTSXP, len)); setCount =1; for(j =0; j < dim; j ++) { for(i =0; i < dim; i++){ indx = COORD_TO_INDEX(i, j , dim); byteIndex = indx / 8; bitIndex = indx % 8; shft = 1 << bitIndex; intIndx = COORD_TO_INDEX(from[attrIndx]-1, to[attrIndx]-1, dim); if(bits[byteIndex] & (shft) ) { INTEGER(origRightPos)[oindx] = oindx + 1 ; INTEGER(origLeftPos)[oindx] = setCount ; oindx++; if(intIndx != indx){ setCount++; } } if(intIndx == indx) { if (nindx < len) { /* guard nindex == 0, len == 0 */ INTEGER(newRightPos)[nindx] = nindx + 1; INTEGER(newLeftPos)[nindx] = setCount ; } nindx++; if(attrIndx < len-1){ attrIndx++; } setCount++; } } } SET_LENGTH(newRightPos, nindx); SET_LENGTH(newLeftPos, nindx); PROTECT(res = allocVector(VECSXP, 4)); SET_VECTOR_ELT(res, 0, newLeftPos); SET_VECTOR_ELT(res, 1, newRightPos); SET_VECTOR_ELT(res, 2, origLeftPos); SET_VECTOR_ELT(res, 3, origRightPos); PROTECT(namesres = allocVector(STRSXP, 4)); SET_STRING_ELT(namesres, 0, mkChar("newLeftPos")); SET_STRING_ELT(namesres, 1, mkChar("newRightPos")); SET_STRING_ELT(namesres, 2, mkChar("origLeftPos")); SET_STRING_ELT(namesres, 3, mkChar("origRightPos")); setAttrib(res, R_NamesSymbol, namesres); UNPROTECT(6); return(res); } graph/src/Makevars0000644000175000017500000000031714136046755014004 0ustar nileshnileshafter: $(SHLIB) mv $(SHLIB) BioC_graph$(SHLIB_EXT) # By default, 'R CMD build' won't remove that file so it will end up in the # source tarball (observed with R 2.12.0). clean: rm BioC_graph$(SHLIB_EXT) graph/vignettes/0000755000175000017500000000000014136072220013512 5ustar nileshnileshgraph/vignettes/graph.Rnw0000644000175000017500000003444614136046755015334 0ustar nileshnilesh% % NOTE -- ONLY EDIT graph.Rnw!!! % graph.tex file will get overwritten. % %\VignetteIndexEntry{Graph} %\VignetteDepends{graph} %\VignetteKeywords{Graph} %\VignettePackage{graph} \documentclass{article} \usepackage{hyperref} \textwidth=6.2in \textheight=8.5in %\parskip=.3cm \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Rmethod}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \newcommand{\Rclass}[1]{{\textit{#1}}} \newcommand{\classdef}[1]{% {\em #1} } \begin{document} \title{How To use the graph package} \maketitle \section{Introduction} The \Rpackage{graph} package provides an implementation of graphs (the kind with nodes and edges) in R. Software infrastructure is provided by three different, but related packages, \begin{description} \item[graph] Provides the basic class definitions and functionality. \item[RBGL] Provides an interface to graph algorithms (such as shortest path, connectivity etc). \item[Rgraphviz] Provides rendering functionality. Different layout algorithms are provided and node plotting, line type, color etc parameters can be controlled by the user. \end{description} A short description of the R classes and methods is given at the end of this document. But here, we begin by creating some graphs and performing different operations on those graphs. The reader will benefit greatly from also have the \Rpackage{Rgraphviz} package available and from using it to render the different graphs as they proceed through these notes. \section{Getting Started} We will first create a graph and then spend some time examining some of the different functions that can be applied to the graph. We will create a random graph as the basis for our explorations (but will delay explaining the creation of this graph until Section~\ref{sec:rg}). First we attach the \Rpackage{graph} package and create a random graph (this is based on the Erdos-Renyi model for random graphs). <>= library(graph) set.seed(123) g1 = randomEGraph(LETTERS[1:15], edges=100) g1 @ We can next list the nodes in our graph, or ask for the degree (since this is an undirected graph we do not distinguish between in-degree and out-degree). For any node in \Robject{g1} we can find out which nodes are adjacent to it using the \Rfunction{adj} function. Or we can find out which nodes are accessible from it using the \Rfunction{acc} function. Both functions are \textit{vectorized}, that is, the user can supply a vector of node names, and each returns a named list. The names of the list elements correspond to the names of the nodes that were supplied. For \Rfunction{acc} the elements of the list are named vectors, the names correspond to the nodes that can be reached and the values correspond to their distance from the starting node. <>= nodes(g1) degree(g1) adj(g1, "A") acc(g1, c("E", "G")) @ One can obtain subgraphs of a given graph by specifying the set of nodes that they are interested in. A subgraph is actually a copy of the relevant part of the original graph. A subgraph is the set of specified nodes plus any edges between them. We can also compute the boundary of a subgraph. The boundary is the set of all nodes in the original graph that have an edge to the specified subgraph. The \Rfunction{boundary} returns a named list with one component for each node in the subgraph. The elements of this list are vectors which contain all nodes in the original graph that have an edge to that element of the subgraph. We also demonstrate two edge related functions in the code chunk below. One retrieves all edges from a graph and is called \Rfunction{edges} while the other retrieves the edge weights and is called \Rfunction{edgeWeights}. <>= sg1 = subGraph(c("A", "E", "F","L"), g1) boundary(sg1, g1) edges(sg1) edgeWeights(sg1) @ \subsection{Some Algebraic Manipulations} The examples here originally came from Chris Volinsky at AT\&T, but have been modified in places as the \Rpackage{graph} package has evolved. In the code chunk below we demonstrate how to create a graph \textit{from scratch}. In this code chunk two graphs are created, \Robject{gR} and \Robject{gR2}, the first is undirected while the second is a directed graph. <>= V <- LETTERS[1:4] edL1 <- vector("list", length=4) names(edL1) <- V for(i in 1:4) edL1[[i]] <- list(edges=c(2,1,4,3)[i], weights=sqrt(i)) gR <- graphNEL(nodes=V, edgeL=edL1) edL2 <- vector("list", length=4) names(edL2) <- V for(i in 1:4) edL2[[i]] <- list(edges=c(2,1,2,1)[i], weights=sqrt(i)) gR2 <- graphNEL(nodes=V, edgeL=edL2, edgemode="directed") @ New graphs can be constructed from these graphs in many different ways but in all cases the existing graph itself is not altered, but rather a copy is made and the changes are carried out on that copy. Nodes and or edges can be added to the graphs using the functions \Rfunction{addNode}, \Rfunction{addEdge}, \Rfunction{removeNode} and \Rfunction{removeEdge}. All functions will take a vector of nodes or edges and add or remove all of them at one time. One other function in this family is \Rfunction{combineNodes}, this function takes a vector of nodes and a graph and combines those nodes into a single new node (the name of which must be supplied). The function \Rfunction{clearNode} removes all edges to the specified nodes. <>= gX = addNode(c("E", "F"), gR) gX gX2 = addEdge(c("E", "F", "F"), c("A", "D", "E"), gX, c(1,2,3)) gX2 gR3 = combineNodes(c("A","B"), gR, "W") gR3 clearNode("A", gX) @ When working with directed graphs it is sometimes of interest to find the \textit{underlying} graph. This is the graph with all edge orientation removed. The function \Rfunction{ugraph} provides this functionality. <>= ##find the underlying graph ugraph(gR2) @ Other operations that can be carried out on graphs, that are of some interest, are unions, intersections and complements. We have take a rather specialized definition of these operations and it is not one that is widely used, but it is very useful for the bioinformatics and computational biology projects that we are working on. For two or more graphs all with \textbf{the same nodes} we define: \begin{description} \item[union] to be the graph with the same set of nodes as the inputs and edges between any two nodes that were connected in any one graph. \item[intersection] to be the graph with the same set of nodes as the inputs and with edges between two nodes if there was an edge in all graphs. \item[complement] to be the graph with the same set of nodes as its input and edges in the complement if there were none in the original graph. \end{description} In the code chunk below we generate a random graph and then demonstrate the concepts of union, intersection and complement. <>= set.seed(123) gR3 <- randomGraph(LETTERS[1:4], M<-1:2, p=.5) x1 <- intersection(gR,gR3) x1 x2 <- union(gR,gR3) x2 x3 <- complement(gR) x3 @ Notice that while the graphs \Robject{gR} and \Robject{gR2} have different sets of edge weights these are lost when the \Rmethod{union}, \Rmethod{intersection} and \Rmethod{complement} are taken. It is not clear how they should be treated and in the current implementation they are ignored and replaced by weight 1 in the output. \section{Random Graphs} \label{sec:rg} Three basic strategies for finding random graphs have been implemented: \begin{description} \item[randomEGraph] A random edge graph. In this graph edges are randomly generated according to a specified probability, or the number of edges can be specified and they are randomly assigned. \item[randomGraph] For this graph the number of nodes is specified as well as some latent factor. The user provides both the node labels and a factor with some fixed number of levels. Each node is randomly assigned levels of the factor and then edges are created between nodes that share the same levels of the factor. \item[randomNodeGraph] A random graph with a pre-specified node distribution is generated. \end{description} The function \Rfunction{randomEGraph} will generate graphs using the random edge model. In the code chunk below we generate a graph, \Robject{g1} on 12 nodes (with labels from the first 12 letters of the alphabet) and specify that the probability of each edge existing is $0.1$. The graph \Robject{g2} is on the same set of nodes but we specify that it will contain 20 edges. <>= set.seed(333) V = letters[1:12] g1 = randomEGraph(V, .1) g1 g2 = randomEGraph(V, edges=20) g2 @ The function \Rfunction{randomGraph} generates graphs according to the latent variable model. In the code chunk bel <>= set.seed(23) V <- LETTERS[1:20] M <- 1:4 g1 <- randomGraph(V, M, .2) @ Our last example involves the generating random graphs with a prespecified node degree distribution. In the example below we require a node degree distribution of 1, 1, 2 and 4. We note that self-loops are allowed (and if someone wants to provide the code to eliminate them, we would be glad to have it). <>= set.seed(123) c1 <- c(1,1,2,4) names(c1) <- letters[1:4] g1 <- randomNodeGraph(c1) @ \section{Some Graph Algorithms} In addition to the simple algebraic operations that we have demonstrated in the preceeding sections of this document we also have available implementations of some more sophisticated graph algorithms. If possible though, one should use the algorithms provided in the \Rpackage{RBGL}. The function \Rfunction{connComp} returns a list of the connected components of the given graph. For a \textit{directed graph} or \textit{digraph} the underlying graph is the graph that results from removing all direction from the edges. This can be achieved using the function \Rfunction{ugraph}. A weakly connected component of a digraph is one that is a connected component of the underlying graph and this is the default behavior of \Rfunction{connComp}. <>= g1 g1cc <- connComp(g1) g1cc g1.sub <- subGraph(g1cc[[1]], g1) g1.sub @ Another useful set of graph algorithms are the so-called searching algorithm. For the \Rpackage{graph} package we have implemented the depth first searching algorithm as described in Algorithm 4.2.1 of \cite{GrossYellen}. More efficient and comprehensive algorithms are available through the \Rpackage{RBGL} package. The returned value is a named vector. The names correspond to the nodes of the graph and the values correspond to the distance (often the number of steps) or sum of the edgeweights along the path to that node. <>= DFS(gX2, "E") @ \section{Special Types of Graphs} We have found it useful to define a few special types or classes of graphs for some bioinformatic problems but they likely have broader applicability. All of the functions described above should have methods for these special types of graphs (although we may not yet have implemented all of them, please let the maintainer know if you detect any omissions). First is the \Robject{clusterGraph}. A cluster graph is a graph where the nodes are separated into groups or clusters. Within a cluster all nodes are connected (a complete graph) but between clusters there are no edges. Such graphs are useful representations of the output of clustering algorithms. <>= cG1 <- new("clusterGraph", clusters=list(a=c(1,2,3), b=c(4,5,6))) cG1 acc(cG1, c("1", "2")) @ The other special type of graph that we have implemented is based on distances. This graph is completely connected but the edge weights come from inter-node distances (perhaps computed from an expression experiment). <>= set.seed(123) x <- rnorm(26) names(x) <- letters library(stats) d1 <- dist(x) g1 <- new("distGraph", Dist=d1) g1 @ \section{Coercion} There are very many different ways to represent graphs. The one chosen for our basic implementation is a node and edge-list representation. However, many others use an adjacency matrix representation. We provide a number of different tools that should help users coerce graphs between the different representations. Coercion from an adjacency matrix to a \Rclass{graphNEL} object requires a numeric matrix with both row and column names. These are taken to define the nodes of the graph and the edge weights in the resultant graph are determined by the values in the array (weights zero are taken to indicate the absence of an edge). The function \Rfunction{ftM2adjM} converts a \textit{from-to} matrix into an adjacency matrix. Conversion to a \Rclass{graphNEL} graph can be carried out using the \Rfunction{as} method for that class. An \texttt{aM} is an affiliation matrix which is frequently used in social networks analysis. The rows of \texttt{aM} represent actors, and the columns represent events. A one, \texttt{1}, in the ith row and jth column represents the affiliation of the ith actor with the jth event. The function \Rfunction{aM2bpG} coerces a \texttt{aM} into an instance of the \Rclass{graphNEL} where the nodes are both the actors and the events (there is currently no bipartite graph representation, although one could be added). The two functions \Rfunction{sparseM2Graph} and \Rfunction{graph2SparseM} provide coercion between \Rclass{graphNEL} instances and sparse matrix representations. Currently we rely on the \Rpackage{SparseM} of Koncker and Ng for the sparse matrix implementation. @ \subsection{Classes} We briefly review some of the class structure here and refer the reader to the technical documentation for this package for more details. The basic class, \Rclass{graph}, is a virtual class and all other classes will extend this class. There are three main implementations available. Which is best will depend on the particular data set and what the user wants to do with it. The only slot defined in the virtual class is \Robject{edgemode} which can be either \textit{directed} or \textit{undirected} indicating whether the edges are directed or not. The class \Rclass{graphNEL} is a node and edge-list representation of a graph. That is the graph is comprised of two components a list of nodes and a list of the out edges for each node. The class \Rclass{graphAM} is an adjacency matrix implementation. It will be developed next and will use the \Rpackage{SparseM} package if it is available. The class \Rclass{clusterGraph} is a special form of graph for clustering. In this graph each cluster is a completely connected component (a clique) and there are no between cluster edges. \end{document} graph/vignettes/MultiGraphClass.Rnw0000644000175000017500000004436514136046755017276 0ustar nileshnilesh%\VignetteIndexEntry{graphBAM and MultiGraph classes} %\VignetteDepends{graph} %\VignetteKeywords{Graph} %\VignettePackage{graph} \documentclass{article} \usepackage{hyperref} \textwidth=6.2in \textheight=8.5in \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Rmethod}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \newcommand{\Rclass}[1]{{\textit{#1}}} \newcommand{\Rcode}[1]{{\texttt{#1}}} \newcommand{\classdef}[1]{% {\em #1} } \begin{document} \title{graphBAM and MultiGraph classes.} \author{N. Gopalakrishnan} \maketitle \section{graphBAM class} \subsection{Introduction} The \Rclass{graphBAM} class has been created as a more efficient replacement for the \Rclass{graphAM} class in the \Rpackage{graph} package. The adjacency matrix in the \Rclass{graphBAM} class is represented as a bit array using a \Rcode{raw} vector. This significantly reduces the memory occupied by graphs having a large number of nodes. The bit vector representation also provides advantages in terms of performing operations such as intersection or union of graphs. We first load the \Rpackage{graph} package which provides the class definition and methods for the \Rclass{graphBAM} class. <>= library(graph) @ One of the arguments \Rcode{df} to the \Rclass{graphBAM} constructor is a \Robject{data.frame} containing three columns: "from","to" and "weight", each row in the \Robject{data.frame} representing an edge in the graph. The \Rcode{from} and \Rcode{to} columns can be character vectors or factors, while the \Rcode{weight} column must be a numeric vector. The argument \Rcode{nodes} are calculated from the unique names in the \Rcode{from} and \Rcode{to} columns of the \Robject{data.frame}. The argument \Rcode{edgeMode} should be a character vector, either "directed" or "undirected" indicating whether the graph represented should be directed or undirected respectively. \subsection{ A simple graph represented using graphBAM class} We proceed to represent a simple graph using the \Rclass{graphBAM} class. Our example is a directed graph representing airlines flying between different cities. In this example, cities represent the nodes of the graph and each edge represents a flight from an originating city (\Rcode{from}) to the destination city (\Rcode{to}). The weight represents the fare for flying between the \Rcode{from} and \Rcode{to} cities. <>= df <- data.frame(from = c("SEA", "SFO", "SEA", "LAX", "SEA"), to = c("SFO", "LAX", "LAX", "SEA", "DEN"), weight = c( 90, 96, 124, 115, 259), stringsAsFactors = TRUE) g <- graphBAM(df, edgemode = "directed") g @ The cities (nodes) included in our \Rclass{graph} object as well as the stored fares(\Rcode{weight}) can be obtained using the \Rmethod{nodes} and \Rmethod{edgeWeights} methods respectively. <>= nodes(g) edgeWeights(g, index = c("SEA", "LAX")) @ Additional nodes or edges can be added to our graph using the \Rmethod{addNode} and \Rmethod{addEdge} methods. For our example, we first add a new city "IAH" to our graph. We then add a flight connection between "DEN" and "IAH" having a fare of \$120. <>= g <- addNode("IAH", g) g <- addEdge(from = "DEN", to = "IAH", graph = g, weight = 120) g @ Similarly edges and nodes can be removed from the graph using the \Rmethod{removeNode} and \Rmethod{removeEdge} methods respectively. We proceed to remove the flight connection from "DEN" to "IAH" and subsequently the node "IAH". <>= g <- removeEdge(from ="DEN", to = "IAH", g) g <- removeNode(node = "IAH", g) g @ We can create a subgraph with only the cities "DEN", "LAX" and "SEA" using the \Rmethod{subGraph} method. <>= g <- subGraph(snodes = c("DEN","LAX", "SEA"), g) g @ We can extract the \Rcode{from}-\Rcode{to} relationships for our graph using the \Rmethod{extractFromTo} method. <>= extractFromTo(g) @ \subsection{Mice gene interaction data for brain tissue (SAGE data)} The C57BL/6J and C3H/HeJ mouse strains exhibit different cardiovascular and metabolic phenotypes on the hyperlipidemic apolipoprotein E (Apoe) null background. The interaction data for the genes from adipose, brain, liver and muscle tissue samples from male and female mice were studied. This interaction data for the various genes is included in the \Rpackage{graph} package as a list of \Robject{data.frame}s containing information for \Rcode{from-gene}, \Rcode{to-gene} and the strength of interaction \Rcode{weight} for each of the tissues studied. We proceed to load the data for male and female mice. <>= data("esetsFemale") data("esetsMale") @ We are interested in studying the interaction data for the genes in the brain tissue for male and female mice and hence proceed to represent this data as directed graphs using \Rclass{graphBAM} objects for male and female mice. <>= dfMale <- esetsMale[["brain"]] dfFemale <- esetsFemale[["brain"]] head(dfMale) @ <>= male <- graphBAM(dfMale, edgemode = "directed") female <- graphBAM(dfFemale, edgemode = "directed") @ We are interested in pathways that are common to both male and female graphs for the brain tissue and hence proceed to perform a graph intersection operation using the \Rmethod{graphIntersect} method. Since edges can have different values of the weight attribute, we would like the result to have the sum of the weight attribute in the male and female graphs. We pass in \Rcode{sum} as the function for handling weights to the \Rcode{edgeFun} argument. The \Rcode{edgeFun} argument should be passed a list of named functions corresponding to the edge attributes to be handled during the intersection process. <>= intrsct <- graphIntersect(male, female, edgeFun=list(weight = sum)) intrsct @ If node attributes were present in the \Robject{graphBAM} objects, a list of named function could be passed as input to the \Rcode{graphIntersect} method for handling them during the intersection process. We proceed to remove edges from the \Robject{graphBAM} result we just calculated with a weight attribute less than a numeric value of 0.8 using the \Rmethod{removeEdgesByWeight} method. <>= resWt <- removeEdgesByWeight(intrsct, lessThan = 1.5) @ Once we have narrowed down to the edges that we are interested in, we would like to change the color attribute for these edges in our original \Robject{graphBAM} objects for the male and female graphs to "red". Before an attribute can be added, we have to set its default value using the \Rfunction{edgedataDefaults} method. For our example, we set the default value for the color attribute to white. We first obtain the from - to relationship for the \Rcode{resWt} graph using the \Rmethod{extractFromTo} method and then make use of the \Rmethod{edgeData} method to update the "color" edge attribute. <>= ftSub <- extractFromTo(resWt) edgeDataDefaults(male, attr = "color") <- "white" edgeDataDefaults(female, attr = "color") <- "white" edgeData(male, from = as.character(ftSub[,"from"]), to = as.character(ftSub[,"to"]), attr = "color") <- "red" edgeData(female, from = as.character(ftSub[,"from"]), to = as.character(ftSub[,"to"]), attr = "color") <- "red" @ \section{MultiGraphs} \subsection{Introduction} The \Rclass{MultiGraph} class can be used to represent graphs that share a single node set and have have one or more edge sets, each edge set representing a different type of interaction between the nodes. An \Robject{edgeSet} object can be described as representing the relationship between a set of from-nodes and to-nodes which can either be directed or undirected. A numeric value (weight) indicates the strength of interaction between the connected edges. Self loops are permitted in the \Rclass{MultiGraph} class representation (i.e. the from-node is the same as the to-node). The \Rclass{MultiGraph} class supports the handling of arbitrary node and edge attributes. These attributes are stored separately from the edge weights to facilitate efficient edge weight computation. We shall load the \Rpackage{graph} and \Rpackage{RBGL} packages that we will be using. We will then create a \Rclass{MultiGraph} object and then spend some time examining some of the different functions that can be applied to \Rclass{MultiGraph} objects. <>= library(graph) library(RBGL) @ \subsection{ A simple MultiGraph example} We proceed to construct a \Rclass{MultiGraph} object with directed \Robject{edgeSets} to represent the flight connections of airlines Alaska, Delta, United and American that fly between the cities Baltimore, Denver, Houston, Los Angeles, Seattle and San Francisco. For our example, the cities represent the nodes of the \Rclass{MultiGraph} and we have one \Robject{edgeSet} each for the airlines. Each \Robject{edgeSet} represents the flight connections from an originating city(\Rcode{from}) to the destination city(\Rcode{to}). The weight represents the fare for flying between the \Rcode{from} and \Rcode{to} cities. For each airline, we proceed to create a \Rclass{data.frame} containing the originating city, the destination city and the fare. <>= ft1 <- data.frame( from = c("SEA", "SFO", "SEA", "LAX", "SEA"), to = c("SFO", "LAX", "LAX", "SEA", "DEN"), weight = c( 90, 96, 124, 115, 259), stringsAsFactors = TRUE) ft2 <- data.frame( from = c("SEA", "SFO", "SEA", "LAX", "SEA", "DEN", "SEA", "IAH", "DEN"), to = c("SFO", "LAX", "LAX", "SEA", "DEN", "IAH", "IAH", "DEN", "BWI"), weight= c(169, 65, 110, 110, 269, 256, 304, 256, 271), stringsAsFactors = TRUE) ft3 <- data.frame( from = c("SEA", "SFO", "SEA", "LAX", "SEA", "DEN", "SEA", "IAH", "DEN", "BWI"), to = c("SFO", "LAX", "LAX", "SEA", "DEN", "IAH", "IAH", "DEN", "BWI", "SFO"), weight = c(237, 65, 156, 139, 281, 161, 282, 265, 298, 244), stringsAsFactors = TRUE) ft4 <- data.frame( from = c("SEA", "SFO", "SEA", "SEA", "DEN", "SEA", "BWI"), to = c("SFO", "LAX", "LAX", "DEN", "IAH", "IAH", "SFO"), weight = c(237, 60, 125, 259, 265, 349, 191), stringsAsFactors = TRUE) @ These data frames are then passed to \Rclass{MultiGraph} class constructor as a named \Robject{list}, each member of the list being a \Robject{data.frame} for an airline. A logical vector passed to the \Rcode{directed} argument of the \Rclass{MultiGraph} constructor indicates whether the \Robject{MultiGraph} to be created should have directed or undirected edge sets. <>= esets <- list(Alaska = ft1, United = ft2, Delta = ft3, American = ft4) mg <- MultiGraph(esets, directed = TRUE) mg @ The nodes (cities) of the \Rclass{MultiGraph} object can be obtained by using the \Rmethod{nodes} method. <>= nodes(mg) @ To find the fares for all the flights that originate from SEA for the Delta airline, we can use the \Rmethod{mgEdgeData} method. <>= mgEdgeData(mg, "Delta", from = "SEA", attr = "weight") @ We proceed to add some node attributes to the \Robject{MultiGraph} using the \Rfunction{nodeData} method. Before node attributes can be added, we have to set a default value for each node attribute using the \Rfunction{nodeDataDefuault} method. For our example, we would like to set a default value of square for the node attribute shape. We would like to set the node attribute "shape" for Seattle to the value \Rcode{"triangle"} and that for the cities that connect with Seattle to the value \Rcode{"circle"}. <>= nodeDataDefaults(mg, attr="shape") <- "square" nodeData(mg, n = c("SEA", "DEN", "IAH", "LAX", "SFO"), attr = "shape") <- c("triangle", "circle", "circle", "circle", "circle") @ The node attribute shape for cities we have not specifically assigned a value (such as BWI) gets assigned the default value of "square". <>= nodeData(mg, attr = "shape") @ We then update the edge attribute \Rcode{color} for the Delta airline flights that connect with Seattle to "green". For the remaining Delta flights that connect to other destination in the MultiGraph, we would like to assign a default color of "red". Before edge attributes can be added to the MultiGraph, their default values must be set using the \Rfunction{mgEdgeDataDefaults} method. Subsequently, the \Rfunction{megEdgeData<-} method can be used to update specific edge attributes. <>= mgEdgeDataDefaults(mg, "Delta", attr = "color") <- "red" mgEdgeData(mg, "Delta", from = c("SEA", "SEA", "SEA", "SEA"), to = c("DEN", "IAH", "LAX", "SFO"), attr = "color") <- "green" @ <>= mgEdgeData(mg, "Delta", attr = "color") @ We are only interested in studying the fares for the airlines Alaska, United and Delta and hence would like to create a smaller \Rclass{MultiGraph} object containing edge sets for only these airlines. This can be achieved using the \Rmethod{subsetEdgeSets} method. <>= g <- subsetEdgeSets(mg, edgeSets = c("Alaska", "United", "Delta")) @ We proceed to find out the lowest fares for Alaska, United and Delta along the routes common to them. To do this, we make use of the \Rmethod{edgeSetIntersect0} method which computes the intersection of all the edgesets in a MultiGraph. While computing the intersection of edge sets, we are interesting in retaining the lowest fares in cases where different airlines flying along a route have different fares. To do this, we pass in a named list containing the \Rmethod{weight} function that calculates the minimum of the fares as the input to the \Rmethod{edgeSetIntersect0} method. (The user has the option of specifying any function for appropriate handling of edge attributes ). <>= edgeFun <- list( weight = min) gInt <- edgeSetIntersect0(g, edgeFun = edgeFun) gInt @ The edge set by the \Rmethod{edgeSetIntersect0} operation is named by concatenating the names of the edgeSets passed as input to the function. <>= mgEdgeData(gInt, "Alaska_United_Delta", attr= "weight") @ \subsection{MultiGraph representation of mice gene interaction data. (SAGE)} The C57BL/6J and C3H/HeJ mouse strains exhibit different cardiovascular and metabolic phenotypes on the hyperlipidemic apolipoprotein E (Apoe) null background. The interaction data for the genes from adipose, brain, liver and muscle tissue samples from male and female mice were studied. This interaction data for the various genes is included in the \Rpackage{graph} package as a list of \Robject{data.frame}s containing information for \Rcode{from-gene}, \Rcode{to-gene} and the strength of interaction \Rcode{weight} for each of the tissues studied. We proceed to load the data for male and female mice. <>= data("esetsFemale") data("esetsMale") names(esetsFemale) head(esetsFemale$brain) @ The \Robject{esetsFemale} and \Robject{esetsMale} objects are a named \Robject{list} of data frames corresponding to the data obtained from adipose, brain, liver and muscle tissues for the male and female mice that were studied. Each data frame has a from, to and a weight column corresponding to the from and to genes that were studied and weight representing the strength of interaction of the corresponding genes. We proceed to create \Rclass{MultiGraph} objects for the male and female data sets by making use of the \Rclass{MultiGraph} constructor, which directly accepts a named list of data frames as the input and returns a MultiGraph with edgeSets corresponding to the names of the data frames. <>= female <- MultiGraph(edgeSets = esetsFemale, directed = TRUE) male <- MultiGraph(edgeSets = esetsMale, directed = TRUE ) male female @ We then select a particular gene of interest in this network and proceed to identify its neighboring genes connected to this gene in terms of the maximum sum of weights along the path that connects the genes for the brain edge set. We are interested in the gene "10024416717" and the sum of the weights along the path that connects this genes to the other genes for the brain tissue. Since the algorithms in the \Rpackage{RBGL} package that we will use to find the edges that are connected to the gene "10024416717" do not work directly with \Rpackage{MultiGraph} objects, we proceed to create \Rcode{graphBAM} objects from the male and female edge sets for the brain tissue. \Rpackage{MultiGraph} objects can be converted to a named list of \Robject{graphBAM} objects using the \Rmethod{graphBAM} method. <>= maleBrain <- extractGraphBAM(male, "brain")[["brain"]] maleBrain femaleBrain <- extractGraphBAM(female, "brain")[["brain"]] @ We then identify the genes connected to gene "10024416717" as well as the sum of the weights along the path that connect the identified genes using the function \Rfunction{bellman.ford.sp} function from the \Rpackage{RBGL} package. <>= maleWt <- bellman.ford.sp(maleBrain, start = c("10024416717"))$distance maleWt <- maleWt[maleWt != Inf & maleWt != 0] maleWt femaleWt <- bellman.ford.sp(femaleBrain, start = c("10024416717"))$distance femaleWt <- femaleWt[femaleWt != Inf & femaleWt != 0] femaleWt @ For the subset of genes we identified, we proceed to add node attributes to our original \Robject{MultiGraph} objects for the male and female data. The node "10024416717" and all its connected nodes are assigned a color attribute "red" while the rest of the nodes are assigned a color color attribute of "gray". <>= nodeDataDefaults(male, attr = "color") <- "gray" nodeData(male , n = c("10024416717", names(maleWt)), attr = "color" ) <- c("red") nodeDataDefaults(female, attr = "color") <- "gray" nodeData(female , n = c("10024416717", names(femaleWt)), attr = "color" ) <- c("red") @ Our \Robject{MultiGraph} objects now contain the required node attributes for the subset of genes that we have narrowed our selection to. For the \Robject{MultiGraph} objects for male and female, we are also interested in the genes that are common to both \Robject{MultiGraph}s. This can be calculated using the \Rfunction{graphIntersect} method. <>= resInt <- graphIntersect(male, female) resInt @ The operations we have dealt with so far only deal with manipulation of \Rclass{MultiGraph} objects. Additional functions will need to be implemented for the visualization of the \Rclass{MultiGraph} objects. \end{document} graph/vignettes/graphAttributes.Rnw0000644000175000017500000001367014136046755017377 0ustar nileshnilesh% % NOTE -- ONLY EDIT howtogenefilter.Rnw!!! % Biobase.tex file will get overwritten. % %\VignetteIndexEntry{Attributes for Graph Objects} %\VignetteDepends{graph} %\VignetteKeywords{Graph} %\VignettePackage{graph} \documentclass{article} \usepackage{hyperref} \textwidth=6.2in \textheight=8.5in \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Rmethod}[1]{{\texttt{#1}}} \newcommand{\Rcode}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \newcommand{\Rclass}[1]{{\textit{#1}}} \newcommand{\classdef}[1]{% {\em #1} } \newcommand{\myincfig}[3]{\begin{figure}[htbp] \begin{center} \includegraphics[width=#2]{#1} \caption{\label{#1}#3} \end{center} \end{figure}} \begin{document} \title{Attributes for Graph Objects} \author{Seth Falcon} \maketitle \section{Introduction} The \Rpackage{graph} package provides representations of graphs (nodes and edges) as S4 classes. This vignette demonstrates how to add arbitrary node and edge attributes to graph objects. First, we create a graph to use as an example. We will work with a \Rclass{graphAM-class} instance, however, any subclass of \Rclass{graph-class} would work. See Figure~\ref{foo}. <>= library("graph") mat <- matrix(c(0, 0, 1, 1, 0, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0), byrow=TRUE, ncol=4) rownames(mat) <- letters[1:4] colnames(mat) <- letters[1:4] @ <>= g1 <- graphAM(adjMat=mat) @ <>= if (require("Rgraphviz")) { gn = as(g1, "graphNEL") plot(gn, nodeAttrs=makeNodeAttrs(gn, shape="circle", fillcolor="orange")) } else { plot(1, 1, main="Rgraphviz required for this plot") } @ \myincfig{foo}{0.33\textwidth}{The graph \Robject{g1}.} \section{Edge Attributes} \subsection{Default edge attributes} All edges in a graph support the same set of attributes. The set of supported attributes can be defined and accessed using the \Rmethod{edgeDataDefaults} method. A new graph instance will not have any edge attributes defined. % <>= edgeDataDefaults(g1) @ When a new edge attribute is defined, a default value must be specified. Here we will define two edge attributes: \Rcode{weight} and \Rcode{code} and specify a default value for each one. <>= edgeDataDefaults(g1, "weight") <- 1 edgeDataDefaults(g1, "code") <- "plain" edgeDataDefaults(g1) @ The default value for a particular attribute can be obtained by specifying the attribute name in the call to \Rmethod{edgeDataDefaults}. <>= edgeDataDefaults(g1, "weight") @ \subsection{Getting edge attributes} Edge attributes are set and accessed using the \Rmethod{edgeData} method. Only attributes defined using \Rmethod{edgeDataDefaults} can be accessed using \Rmethod{edgeData}. If an attribute has not be set using \Rmethod{edgeData} for a given edge, then the default value is used. <>= edgeData(g1, from="a", to="d", attr="weight") edgeData(g1, from="a", attr="weight") edgeData(g1, to="a", attr="weight") allAttrsAllEdges <- edgeData(g1) weightAttrAllEdges <- edgeData(g1, attr="weight") @ \subsection{Setting edge attributes} Attributes are set using the replacement form of \Rmethod{edgeData}. This method allows the user to update the attribute for single edge, set the attributes for a collection of edges to a single value, and to set the attributes for a collection of edges to different values specified by a vector of values. <>= edgeData(g1, from="a", to="d", attr="weight") <- 2 edgeData(g1, from="a", attr="code") <- "fancy" edgeData(g1, from="a", attr="weight") edgeData(g1, from="a", attr="code") @ We can set the attributes for multiple edges to a single value. <>= f <- c("a", "b") t <- c("c", "c") edgeData(g1, from=f, to=t, attr="weight") <- 10 edgeData(g1, from=f, to=t, attr="weight") @ It is also possible to set multiple attributes to different values in a single call to \Rmethod{edgeData}. <>= edgeData(g1, from=f, to=t, attr="weight") <- c(11, 22) edgeData(g1, from=f, to=t, attr="weight") @ Finally, we can set the an attribute to a vector of values by packing it into a list: % <>= edgeData(g1, from="a", to="d", attr="code") <- list(1:10) edgeData(g1, from=f, to=t, attr="weight") <- mapply(c, f, t, "e", SIMPLIFY=FALSE) edgeData(g1, from="a", to="d", attr="code") edgeData(g1, from=f, to=t, attr="weight") @ \section{Node Attributes} \subsection{Default node attributes} Like edge attributes, all nodes in a graph support the same set of attributes. The supported set of attributes and their default values is accessed using the \Rmethod{nodeDataDefaults} method. The interface is similar to \Rmethod{edgeDataDefaults}. <>= nodeDataDefaults(g1) nodeDataDefaults(g1, attr="weight") <- 1 nodeDataDefaults(g1, attr="type") <- "vital" nodeDataDefaults(g1) nodeDataDefaults(g1, "weight") @ As with edge attributes, default values are required for each node attribute. The default value is used as the node attribute for all nodes in the graph that have not had their attribute value explicitly set. Attribute values can be any R object. \subsection{Getting and setting node attributes} Once a node attribute has been defined and given a default value using \Rmethod{nodeDataDefaults}, individual node attributes can be accessed using \Rmethod{nodeData}. <>= nodeData(g1, n="a") nodeData(g1, n="a", attr="weight") <- 100 nodeData(g1, n=c("a", "b"), attr="weight") nodeData(g1, n=c("a", "b"), attr="weight") <- 500 nodeData(g1, n=c("a", "b"), attr="weight") nodeData(g1, n=c("a", "b"), attr="weight") <- c(11, 22) nodeData(g1, n=c("a", "b"), attr="weight") @ <>= ## We need to reconcile this #g2 <- as(g1, "graphNEL") #edgeWeights(g2) @ \end{document} graph/vignettes/GraphClass.Rnw0000644000175000017500000002714114136046755016254 0ustar nileshnilesh% % NOTE -- ONLY EDIT GraphClass.Rnw!!! % GraphClass.tex file will get overwritten. % %\VignetteIndexEntry{Graph Design} %\VignetteDepends{graph} %\VignetteKeywords{Graph} %\VignettePackage{graph} \documentclass{article} \usepackage{hyperref} \textwidth=6.2in \textheight=8.5in %\parskip=.3cm \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Rmethod}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \newcommand{\Rclass}[1]{{\textit{#1}}} \newcommand{\classdef}[1]{% {\em #1} } \begin{document} \section{Introduction} The purpose of this document is to describe the implementation the classes used to represent graphs in the \Rpackage{graph} package and to discuss design issues for future development. There are many different ways to represent a graph and to deal with the edges and nodes within that graph. Below we discuss the graph representations implemented in the \Rpackage{graph} package and define the set of methods that form the \textit{graph interface} as determined empiracally by the methods used by packages like \Rpackage{RBGL} when interacting with \Robject{graph} objects. A graph is a pair of sets, $G=(V,E)$ where $V$ is the set of nodes and $E$ is the set of edges, which are determined by relationships that exist between the nodes. If we let $n = |V|$, be the number of nodes then, excluding self-loops there are at most $n$ choose 2 edges in $G$. A \textit{simple graph} is a graph with at most one edge between any pair of nodes and no self-loops. \section{The \Rclass{graph} class} The \Rclass{graph} class and its subclasses support simple graphs as well as graphs with at most one self-loop on any given node. Not all graph representations can easily support more general graphs. Limiting to simple graphs with self-loops allows for reversible conversions between different graph representations. Furthermore, this limitation simplifies the interface of edge related methods which would otherwise have to support ways of identifying one of many edges between the same pair of nodes. Arbitrary attributes can be associated with a graph, with a node, or with an edge. For both nodes and edges if one edge or node has a particular attribute then all nodes and edges must have that attribute. Nodes and edges can have more than one attribute associated with them. \textit{This raises the question of whether we should use the \Rclass{AnnotatedDataFrame} class from Biobase here as a way to implement general node and edge attributes.} \textit{However, currently AnnotatedDataFrame is based on a data.frame and cannot easily support arbitrary attributes. Even having a vector of length greater than one as the value of an attribute could cause problems.} The \Rclass{graph} class itself is VIRTUAL and has the following definition: <>= library("graph") getClass("graph") @ The \Robject{edgemode} slot indicates whether the graph is \textit{directed} or \textit{undirected}. Since some graph algorithms only make sense in a directed graph, the edgemode is a property of the entire graph, rather than a property of an edge. The \Robject{graphData} slot was recently added to hold arbitrary attributes for the graph. Although edgemode is such an attribute, it isn't clear whether it should move inside the generic container since edgemode is of such high semantic importance. It probably doesn't matter as long as methods such as \Rfunction{isDirected} do the right thing. The \Robject{edgeData} and \Robject{nodeData} slots store the attributes for the edges and nodes of the graph, respectively. There are currently implementations for the \Rclass{graphNEL} class, where nodes are a vector and edges are a list, each element of the list correspondes to one node and the values are nodes corresponding to the out-edges from that node. If the graph is directed then all edges essentially appear twice. The \Rclass{graphAM} class, which stores the edge information in an adjacency matrix. The matrix must be square and the row names must match the column names. If the graph is undirected then the matrix must also be symmetric. There are two specialized classes, \Rclass{distGraph} which takes a distance matrix directly and has special thresholding capabilities. It is not clear whether this should be a specialization of the \Rclass{graphAM} class or not. The second specialized class is a \Rclass{clusterGraph} which can be used to represent the output of a clustering algorithm as a graph. Samples represent nodes and all samples in the same cluster have edges, while samples in distinct clusters do not. Instances of this class must have their edgemode as \texttt{undirected}, if the edgemode is reset then coercion to some other mode of graph is needed. \subsection{Methods of graphs} Here are some of the methods that all graph-like objects should support: \begin{description} \item[nodes(object)] Return a character vector of the node labels. The order is not defined. \item[nodes<-(object)] Return a new graph object with the node labels set as specified by a character vector. This is slightly fragile since here order does matter, but the order can only really be determined by first calling \Rfunction{nodes}. by providing a character vector of the appropriate length. \item[addNode(node, object, edges)] Return a new graph object with additional nodes and (optionally) edges. The methods that have been implemented expect \Robject{node} to be the node labels of the new nodes specified as a character vector. Optional edges can be specified. \item[removeNode(node, object)] Return a new graph object with nodes (and their incident edges) removed. Current methods are implemented for \Robject{node} being a character vector of node labels to remove. \item[edges(object, which)] Return a list with an element for each node in the graph. The names of the list are the node labels. Each element is a character vector giving the node labels of the nodes which the given element shares an edge with. For undirected graphs, reciprocal edges should be included. This representation is very similar to the NEL edgeL structure. \item[edgeWeights(object, index)] \item[addEdge(from, to, graph, weights)] Return a new graph object with additional edges. \item[removeEdge(from, to, graph)] Return a new graph object with the specified edges removed. \item[numNodes(object)] Return a count of the nodes in the graph. \item[numEdges(object)] Return a count of the edges in the graph. \item[isDirected(object)] Return TRUE if the graph is directed and false otherwise. \item[acc(object, index)] See man page. \item[adj(object, index)] See man page. \item[nodeData] Access to node attributes. See man page. \item[edgeData] Access to edge attributes. See man page. \end{description} \subsection{Some Details} Once both nodes and edges are instances of classes they will be quite large. In order to reduce the storage requirements (especially for large graphs) using integer indices may be beneficial. The minimum amount of storage required is $|V|+|E|$. If we use an incidence matrix representation then the storage is $|V|^2$. If we use a node and edge list representation then the storage requirements are $|V|+2|E|$. When either $|V|$ or $|E|$ are large these mechanisms will not be especially efficient. In some cases it may be better to keep the actual node and edge data stored in hash tables and keep other integer vectors available for accessing the necessary components. \subsubsection{Representation of Edges} \label{sec:edgerep} We have taken the approach of allowing the representation of the edge sets to not contain every node. When the graphs are sparse this can be a fairly large savings in space, but it means that one cannot determine the nodes in a graph from the edges in the graph. Also, for the \Rclass{graphNEL} class we do not store the names of the nodes in the NEL, but rather indexes into a the node vector. This is important for allowing us to perform permutations on the nodes of a graph, but causes a number of problems when subsetting graphs, and means that knowledge of the edges does not provide knowledge of the nodes. \section{Multi-graphs} There are no clear and widely used definitions for multi-graphs, so here we will make clear a definition that we believe will be useful for biological computations. We define a multi-graph to consist of two components, one a set of nodes and the second a list of edge sets. Each edge set corresponds to a potentially different set of relationships between the nodes (which are common to all edge sets). We denote this by $G=(V, E_L)$, where $V$ is the set of nodes and $E_L = (E_1, \ldots, E_L)$ is a collection of $L$ edge sets. Each with a potentially distinct set of relationships. The edge sets are essentially identical to the edge sets for a graph, and hence can have arbitrary attributes associated with them, the edges can be either \textit{directed} or \textit{undirected} and self-loops are allowed. It is not clear whether there should be distinct types of multigraphs as there are graphs. It will surely be more flexible to support a list of edge sets, and to allow these to have different structures. Current definition does not extend the \Rclass{graph} class. The definition is: <>= getClass("multiGraph") @ \begin{description} \item[nodes] A vector of node identifiers. %% FIXME: if these are node identifiers, then shouldn't we use %% "character"? Elsewhere, there seems to be an assumption that %% node labels or identifiers are character. \item[edgeL] A possibly named list of instances of the \Rclass{edgeSet} class. \end{description} The \Rclass{edgeSet} class is a virtual class with several different extensions. These include a \Rclass{edgeSetNEL} and an \Rclass{edgeSetAM}, others will be added once the interface stabilizes. Edge attributes are in the edgeData slot in the edgeSet class. This implies that edgeSets in a multiGraph can have completely unrelated edge attributes. Another approach would be to maintain a list conforming to the edgeSet list containing edge attributes that would enforce the same attributes to be defined for all edges in the multiGraph. \subsection{Methods} In some ways it would be most natural to have \Robject{edges} methods for the \Rclass{edgeSet} class the issues raised in Section~\ref{sec:edgerep} seem to preclude this and it only seems to make sense to have \Robject{node} and \Robject{edges} methods for the \Rclass{multiGraph} class. It will probably make sense to be able to name the edgeSets within a multiGraph and to be able to extract graph objects from the multiGraph representing any of the edgeSets. There should be methods to produce graph objects based on intersection, union, and more complex combination algorithms. The edgeSets may represent interaction data with reliability estimates as edge weights. The user may want to produce a graph object combining the available data to obtain most reliable edges. We may want to consider apply type operations to apply an operation across all edgeSets in a multiGraph. \subsection{Use Cases} An important motivator for the \Rclass{multiGraph} class is the representation of data from protein interaction experiments. Our goal is to represent these data in terms of what interactions were tested, and of those which ones are either positive or negative. \section{Bipartite Graphs} A bipartite graph graph is a graph where the nodes can be divided into two sets, say $V_1$ and $V_2$, such that all edges are between members of $V_1$ and members of $V_2$ and there are no edges between any two elements of $V_1$, nor of $V_2$. \end{document} graph/vignettes/clusterGraph.Rnw0000644000175000017500000000610014136046755016660 0ustar nileshnilesh% % NOTE -- ONLY EDIT clusterGraph.Rnw!!! % clusterGraph.tex file will get overwritten. % %\VignetteIndexEntry{clusterGraph and distGraph} %\VignetteDepends{graph, stats} %\VignetteKeywords{Graph, clustering, machine learning} %\VignettePackage{graph} \documentclass{article} \usepackage{hyperref} \textwidth=6.2in \textheight=8.5in %\parskip=.3cm \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Rmethod}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \newcommand{\Rclass}[1]{{\textit{#1}}} \begin{document} \title{How To use the clusterGraph and distGraph classes} \maketitle \section*{Introduction} Graphs can be used to help explore different clustering algorithms. While they have not been extensively used in this regard that is probably due to the lack of software rather than for any other reasons. As we demonstrate below, one can easily and naturally compare different aspects of clustering algorithms using these tools. \section*{clusterGraph} A \textit{clusterGraph} is a graph defined on a set of nodes that have been clustered or grouped in some fashion. The grouping must form a partition of the nodes. In this graph all nodes within the same cluster are adjacent while there are no edges between clusters. Thus, each cluster is a complete graph but there are no between cluster edges. <>= library("graph") library("cluster") data(ruspini) pm <- pam(ruspini, 4) cG <- new("clusterGraph", clusters = split(names(pm$clustering), pm$clustering)) nodes(cG) @ We now have a graph that we could perform various operations on. For example, we could try a second clustering algorithm on the same data and see if the two largely agree. <>= library(stats) km = kmeans(ruspini, 4) cG.km = new("clusterGraph", clusters=split(as.character(1:75), km$cluster)) inBoth = intersection(cG.km, cG) @ The graph \Robject{inBoth} is of length \Sexpr{length(inBoth)} indicating that there are that many distinct groups. One could, compute various measures of correspondence between the two clustering algorithms using the graph representation. \section*{distGraph} We use this same data to consider some potential uses for the \Rclass{distGraph} class. Others have considered a similar structure for exploring clustering algorithms. %%FIXME: track down the Butte et al and the Shamir references <<>>= d1 = dist(ruspini) dG = new("distGraph", Dist=d1) rl = NULL j=1 for(i in c(40, 30, 10, 5) ){ nG = threshold(dG, i) rl[[j]] = connComp(nG) j=j+1 } @ We can then examine the components of \Robject{rl} to see how the graph is being reduced. <>= sapply(rl, length) @ <>= dr = range(d1) rl.lens = sapply(rl[[4]], length) @ We see that when we remove all distances that are bigger than 5 units (the range of distances was from \Sexpr{round(dr[1], 3)} to \Sexpr{round(dr[2],3)}) there are still only \Sexpr{length(rl[[4]])} connected components - one of which is of size \Sexpr{max(rl.lens)}. \end{document} graph/build/0000755000175000017500000000000014136072220012601 5ustar nileshnileshgraph/build/vignette.rds0000644000175000017500000000054614136072220015145 0ustar nileshnileshS[O0-M›1`aJ|֑6Ki }h9.`ײȣm,LpD>o qxfM2x5 e=SRFvUn+Uj^=,76:`P \ݶeАp]FG;?cIFY\u-ixmIFߒjm'0JE܁9JT˪e SHKj=[롌6 v- 468`O( F?v͛5HM+5pJz>N1 G{?#hŽ4.[Q_}E'iHEdD?I graph/tests/0000755000175000017500000000000014136046755012662 5ustar nileshnileshgraph/tests/graph_unit_tests.R0000644000175000017500000000006714136046755016372 0ustar nileshnileshBiocGenerics:::testPackage("graph", pattern="_test.R") graph/R/0000755000175000017500000000000014136046755011721 5ustar nileshnileshgraph/R/AllGenerics.R0000644000175000017500000001757214136046755014250 0ustar nileshnilesh## Generic methods that all graph representation classes must support setGeneric("isDirected", function(object) standardGeneric("isDirected")) ## --------------------------------------------------------------------- ## Node and edge access ## --------------------------------------------------------------------- ## setGeneric("getNodes", function(x, which) standardGeneric("getNodes")) setGeneric("edgemode", function(object) standardGeneric("edgemode")) setGeneric("edgemode<-", function(object, value) standardGeneric("edgemode<-")) setGeneric("nodes", function(object, ...) standardGeneric("nodes")) setGeneric("nodes<-", function(object, value) standardGeneric("nodes<-")) ## internal use only so that nodes<- can be a template method setGeneric("renameNodes", function(g, value) standardGeneric("renameNodes")) setGeneric("edges", signature="object", function(object, which, ...) standardGeneric("edges") ) ## The funny arg=1, is to allow default values in the methods. ## We don't want to dispatch on those args, but we want them ## named as part of the interface, hence the trick of putting them ## after the (...). Note that this means partial matching for those ## args will not work, must specify full name. setGeneric("edgeWeights", function(object, index, ..., attr="weight", default=1, type.checker=is.numeric) standardGeneric("edgeWeights")) ## --------------------------------------------------------------------- ## --------------------------------------------------------------------- ## Node and edge operations ## --------------------------------------------------------------------- setGeneric("degree", signature="object", function(object, Nodes) standardGeneric("degree") ) setGeneric("adj", function(object, index) standardGeneric("adj")) setGeneric("acc", function(object, index) standardGeneric("acc")) setGeneric("numNodes", function(object) standardGeneric("numNodes")) setGeneric("numEdges", function(object) standardGeneric("numEdges")) ## default function numNoEdges(objGraph) already exists ##setGeneric("numNoEdges", function(object) standardGeneric("numNoEdges")) setGeneric("addNode", function(node, object, edges) standardGeneric("addNode")) setGeneric("removeNode", function(node, object) standardGeneric("removeNode")) setGeneric("clearNode", function(node, object) standardGeneric("clearNode")) setGeneric("combineNodes", function(nodes, graph, newName, ...) standardGeneric("combineNodes")) setGeneric("addEdge", function(from, to, graph, weights) standardGeneric("addEdge")) setGeneric("removeEdge", function(from, to, graph) standardGeneric("removeEdge")) setGeneric("removeEdges", function(container, from, to, ...) standardGeneric("removeEdges")) setGeneric("removeEdgesByWeight", function(graph, ...) standardGeneric("removeEdgesByWeight")) ## --------------------------------------------------------------------- ## --------------------------------------------------------------------- ## attrData generics ## --------------------------------------------------------------------- setGeneric("attrDefaults", function(self, attr) standardGeneric("attrDefaults")) setGeneric("attrDefaults<-", function(self, attr, value) standardGeneric("attrDefaults<-")) setGeneric("attrDataItem", function(self, x, attr) standardGeneric("attrDataItem")) setGeneric("attrDataItem<-", function(self, x, attr, value) standardGeneric("attrDataItem<-")) setGeneric("removeAttrDataItem<-", function(self, x, value) standardGeneric("removeAttrDataItem<-")) ## --------------------------------------------------------------------- ## graph, node, edge attribute generics ## --------------------------------------------------------------------- setGeneric("graphData", function(self, attr) standardGeneric("graphData")) setGeneric("graphData<-", function(self, attr, value) standardGeneric("graphData<-")) setGeneric("edgeDataDefaults", function(self, attr) standardGeneric("edgeDataDefaults")) setGeneric("edgeDataDefaults<-", function(self, attr, value) standardGeneric("edgeDataDefaults<-")) setGeneric("nodeDataDefaults", function(self, attr) standardGeneric("nodeDataDefaults")) setGeneric("nodeDataDefaults<-", function(self, attr, value) standardGeneric("nodeDataDefaults<-")) setGeneric("nodeData", function(self, n, attr) standardGeneric("nodeData")) setGeneric("nodeData<-", function(self, n, attr, value) standardGeneric("nodeData<-")) setGeneric("edgeData", function(self, from, to, attr) standardGeneric("edgeData")) setGeneric("edgeData<-", function(self, from, to, attr, value) standardGeneric("edgeData<-")) setGeneric("mgEdgeDataDefaults", function(self, edgeSet, attr) standardGeneric("mgEdgeDataDefaults")) setGeneric("mgEdgeDataDefaults<-", function(self, edgeSet, attr, value) standardGeneric("mgEdgeDataDefaults<-")) setGeneric("mgEdgeData", function(self, edgeSet, from, to, attr) standardGeneric("mgEdgeData")) setGeneric("mgEdgeData<-", function(self, edgeSet, from, to, attr, value) standardGeneric("mgEdgeData<-")) ## --------------------------------------------------------------------- ## Basic operations setGeneric("DFS", function(object, node, checkConn=TRUE) standardGeneric("DFS")) setGeneric("subGraph", function(snodes, graph) standardGeneric("subGraph")) setGeneric("intersection2", function(x, y) standardGeneric("intersection2")) setGeneric("intersection", function(x, y) standardGeneric("intersection")) setGeneric("join", function(x, y) standardGeneric("join")) setGeneric("ugraph", function(graph) standardGeneric("ugraph")) setGeneric("complement", function(x) standardGeneric("complement")) setGeneric("connComp", function(object) standardGeneric("connComp")) setGeneric("isConnected", function(object, ...) standardGeneric("isConnected")) setGeneric("inEdges", function(node, object) standardGeneric("inEdges")) setGeneric("leaves", signature="object", # don't dispatch on degree.dir function(object, degree.dir) standardGeneric("leaves")) setGeneric("edgeNames", function(object, ...) standardGeneric("edgeNames")) setGeneric("isAdjacent", function(object, from, to, ...) standardGeneric("isAdjacent")) ## Misc setGeneric("Dist", function(object) standardGeneric("Dist")) setGeneric("threshold", function(object, k, value=0) standardGeneric("threshold")) setGeneric("contents", function(object, all.names) standardGeneric("contents")) setGeneric("edgeMatrix", function(object, duplicates=FALSE) standardGeneric("edgeMatrix")) setGeneric("adjacencyMatrix", function(object) standardGeneric("adjacencyMatrix")) setGeneric("edgeL", function(graph, index) standardGeneric("edgeL")) setGeneric("clusteringCoefficient", function(object, ...) standardGeneric("clusteringCoefficient")) ## Generics for GXL setGeneric("fromGXL", function(con) standardGeneric("fromGXL")) setGeneric("dumpGXL", function(con) standardGeneric("dumpGXL")) setGeneric("validateGXL", function(con) standardGeneric("validateGXL")) setGeneric("toGXL", function(object, ...) standardGeneric("toGXL")) setGeneric("property", function(x, prop) standardGeneric("property")) setGeneric("toDotR", function(G, outDotFile, renderList, optList) standardGeneric("toDotR")) ## Updating a graph object setGeneric("updateGraph", function(object) standardGeneric("updateGraph")) setGeneric("extractFromTo", function(g) standardGeneric("extractFromTo")) setGeneric("graphIntersect", function(x, y, ...) standardGeneric("graphIntersect")) setGeneric("graphUnion", function(x, y, ...) standardGeneric("graphUnion")) setGeneric("edgeSets", function(object, ...) standardGeneric("edgeSets")) graph/R/standardLabeling.R0000644000175000017500000000133514136046755015304 0ustar nileshnileshint2ftM <- function(i) { if(!is.numeric(i)||any(i<=0)||!is.vector(i)) stop("'i' must be a positive-valued numeric vector") ## Solve the quadratic equation ## a*n1^2 + b*n1 + c = 0 ## with b<0 and a*c<0. It has a positive solution ## n1 = (-b+sqrt(b*b-4*a*c))/(2*a) ## Here: a=1/2, b=-1/2, c=-i+1 n1 <- floor(0.5+sqrt(0.25+2*(i-1))) n2 <- i - n1*(n1-1)/2 ## +1 since we start counting at 1 return(cbind(n1=n1+1, n2)) } ftM2int <-function(ft) { if(!is.numeric(ft)||any(ft<=0)) stop("'ft' must contain positive numbers.") if(!is.matrix(ft) || !any(dim(ft)==2)) stop("'ft' must be a 2xn or nx2 matrix") if(ncol(ft)!=2) ft <- t(ft) return(ft[,2] + (ft[,1]-1)*(ft[,1]-2)/2) } graph/R/random.R0000644000175000017500000000636414136046755013335 0ustar nileshnilesh##Copyright R. Gentleman, 2002, all rights reserved ##code for generating random graphs ##two different methods of generating random graphs on a given set of ##nodes ##M1: randomly generate edges from the choose(|V|, 2) possible edges ##M2: given V and a set of shared attributes M, select for each node ## of V a subset of M. Then compute edges according to whether ## nodes share common elements of M ##M2: sample "properties" from M with prob p randomGraph <- function(V, M, p, weights = TRUE) { if( any(duplicated(V)) ) stop("node names must be unique") V = as.character(V) lenM <- length(M) lenV <- length(V) nSel <- lapply(V, function(x) M[sample(c(TRUE,FALSE), lenM, TRUE, prob=c(p, 1-p))]) lens <- sapply(nSel, length) objs <- unlist(nSel) wh <- rep(seq_len(lenV), lens) rval <- rep(list(list(edges=numeric(0))), lenV) names(rval) <- V tmp <- split(wh, objs) for( vec in tmp ) for(i in vec) for(j in vec) if( i != j ) { pos <- match(j, rval[[i]]$edges) if(is.na(pos) ) { rval[[i]]$edges <- c(rval[[i]]$edges, j) if (weights) { ln <-length(rval[[i]]$edges) rval[[i]]$weights <- c(rval[[i]]$weights, 1) names(rval[[i]]$weights)[ln] <- j } } else if (weights) rval[[i]]$weights[[pos]] <- rval[[i]]$weights[[pos]]+1 } graphNEL(nodes = V, edgeL=rval) } ## gg<-randomGraph(letters[1:10], 1:4, .3) ## Random Edge Graph randomEGraph <- function(V, p, edges) { nNodes <- length(V) nEdges <- nNodes*(nNodes-1)/2 if( any(duplicated(V)) ) stop("elements of 'V' must be unique") if( !xor(missing(p), missing(edges)) ) stop("specify either 'edges' or 'p'") if( !missing(p) && (!is.numeric(p) || length(p)!=1 || 0>p || p>1 )) stop("for 'p', specify a number between 0 and 1") if( !missing(edges) && (length(edges) != 1 || edges < 0 || edges > nEdges)) stop("for 'edges', specify a number between 0 and ", nEdges) ## sample the edges if(!missing(p)) { i <- which(runif(nEdges) <= p) } else { i <- sample(nEdges, replace=FALSE, size=edges) } ## convert to from-to matrix ft <- int2ftM(i) ## replace integers by node names ft <- cbind(V[ft[,1]], V[ft[,2]]) return(ftM2graphNEL(ft, V=V, edgemode="undirected")) } randomNodeGraph <- function(nodeDegree) { if( any(nodeDegree < 0 ) ) stop("only positive degrees allowed") numEdge <- sum(nodeDegree) if( numEdge %% 2 != 0 ) stop("sum of degrees must be even") wh <- sample(numEdge) Nodes <- rep(names(nodeDegree), nodeDegree) if( is.null(Nodes) ) stop("nodes must be named") from <- Nodes[wh[seq_len(numEdge/2)]] to <- Nodes[wh[(1+numEdge/2):numEdge]] edL <- split(to, from) eN <- names(nodeDegree) outL <- lapply(edL, function(x) list(edges=match(x, eN), weights=rep(1, length(x)))) oL <- rep(list(list(numeric(0))), length(eN)) names(oL) <- eN oL[names(outL)] <- outL g <- graphNEL(nodes=names(oL), edgeL=oL, edgemode="directed") g } graph/R/GXLformals.R0000644000175000017500000001100714136046755014061 0ustar nileshnilesh# # GXL support # ## fromGXL returns the graphNEL object only, and it may ## need to return more properties (7 mar 03) setMethod("fromGXL", signature(con="connection"), function(con) { contents <- paste(readLines(con), collapse="") xmlEventParse <- getExportedValue("XML", "xmlEventParse") xmlEventParse(contents, graph_handler(), asText=TRUE, saxVersion=2)$asGraphNEL() }) ## dumpGXL returns an R list with all? properties setMethod("dumpGXL", "connection", function(con) { xmlEventParse <- getExportedValue("XML", "xmlEventParse") xmlEventParse(paste(readLines(con), collapse=""), NELhandler(),asText=TRUE)$dump() }) ## validate against the dtd setMethod("validateGXL", "connection", function(con) { xmlTreeParse <- getExportedValue("XML", "xmlTreeParse") # maybe need a try here, xmlTreeParse dumps the whole stream when it hits an error tmp <- xmlTreeParse(paste(readLines(con), collapse=""), asText=TRUE, validate=TRUE) }) # # exporting # setMethod("toGXL", signature(object="graphNEL"), function(object, graph.name) { if (missing(graph.name)) { graph.name <- class(object)[1] } gxlTreeNEL(object, graph.name) }) gxlTreeNEL <- function(gnel, graph.name) { qrequire("XML") GXL_NAMESPACE <- c(gxl="http://www.gupro.de/GXL/gxl-1.1.dtd") out <- XML::xmlOutputDOM("gxl", nsURI=GXL_NAMESPACE, nameSpace="gxl") ## NOTE: We could specify dtd="http://www.gupro.de/GXL/gxl-1.0.1.dtd", ## but this might mean that net access is required to write ## GXL which seems quite unacceptable. nodeAttrs <- names(nodeDataDefaults(gnel)) edgeAttrs <- names(edgeDataDefaults(gnel)) writeAttr <- function(attrName, val) { ## skip NA and NULL if (is.null(val) || is.na(val)) return(NULL) ## at present, can only handle length 1 if (length(val) > 1) { warning("GXL conversion only handles attributes ", "with length 1. Will try to represent ", "object of length ", length(val), " as a", "string.") val <- paste(val, collapse=", ") } atag <- switch(typeof(val), integer="int", character="string", double="float", { warning("I don't know how to convert ", "a ", typeof(val), " to GXL. ", " Skipping.") NULL }) if (is.null(atag)) return(NULL) out$addTag("attr", attrs=c(name=attrName), close=FALSE) out$addTag(atag, as.character(val)) out$closeTag() } writeNode <- function(n) { ## Helper function to write a graphNEL node to XML out$addTag("node", attrs=c(id=n), close=FALSE) for (nodeAttr in nodeAttrs) { val <- nodeData(gnel, n, attr=nodeAttr)[[1]] writeAttr(nodeAttr, val) } out$closeTag() ## node } edgeCount <- 1 writeEdge <- function(from, to) { ## Helper function to write a graphNEL node to XML edgeId <- edgeCount edgeCount <<- edgeCount + 1 out$addTag("edge", attrs=c(id=edgeId, from=from, to=to), close=FALSE) for (edgeAttr in edgeAttrs) { val <- edgeData(gnel, from, to, attr=edgeAttr)[[1]] writeAttr(edgeAttr, val) } out$closeTag() ## node } nds <- nodes(gnel) if (!isDirected(gnel)) { ## remove recipricol edges eds <- lapply(gnel@edgeL, function(x) x$edges) eds <- mapply(function(x, y) x[x < y], eds, seq(length=length(eds))) names(eds) <- nodes(gnel) eds <- lapply(eds, function(x) { if (length(x) > 0) nds[x] else character(0) }) } else { eds <- edges(gnel) } enms <- names(eds) out$addTag("graph", attrs=c(id=graph.name, edgemode=edgemode(gnel)), close=FALSE) for (n in nds) { writeNode(n) } for (from in enms) { for (to in eds[[from]]) { writeEdge(from=from, to=to) } } out$closeTag() # graph out } graph/R/bitarray.R0000644000175000017500000000561114136046755013664 0ustar nileshnilesh .indexToCoord <- function(i, nrow) { ## only for square if (nrow == 1L) return(cbind(1L, 1L)) ans <- matrix(0L, nrow = length(i), ncol = 2L) ans[ , 2L] <- ((i - 1L) %/% nrow) + 1L ans[ , 1L] <- ((i - 1L) %% nrow) + 1L ans } .coordToIndex <- function(x, y, nrow) { if (nrow == 1L) return(1L) (y * nrow) - (nrow - x) } .rowIndex <- function(x, n_row, n_col) .coordToIndex(rep(x, n_col), seq_len(n_col), n_row) .columnIndex <- function(y, n_row) .coordToIndex(seq_len(n_row), rep(y, n_row), n_row) makebits <- function(n, bitdim=NULL) { if (!is.null(bitdim)) bitdim <- as.integer(bitdim) n <- as.integer(n) structure(raw(ceiling(n / 8)), bitlen = n, bitdim = bitdim, nbitset = 0L) } bitdim <- function(x, dims) { attr(x, "bitdim") <- dims x } setBitCell <- function(xx, x, y, val) { dim <- attr(xx, "bitdim") idx <- .coordToIndex(x, y, dim[1L]) setbitv(xx, idx, val) } getBitCell <- function(xx, x, y) { dim <- attr(xx, "bitdim") idx <- .coordToIndex(x, y, dim[1L]) testbit(xx, idx) } getColumn <- function(xx, y) { dim <- attr(xx, "bitdim") idx <- .columnIndex(y, dim[1L]) testbit(xx, idx) ## wonder if there is a nice optimization since we will be reading ## consecutive bits for column oriented storage. } getRow <- function(xx, x) { dim <- attr(xx, "bitdim") n_row <- dim[1L] n_col <- dim[2L] idx <- .rowIndex(x, n_row, n_col) testbit(xx, idx) } bitlen <- function(x) attr(x, "bitlen") nbitset <- function(x) attr(x, "nbitset") bitToLogical <- function(x) { len <- attr(x, "bitlen") if (is.null(len)) len <- length(x) * 8L sapply(seq_len(len), function(i) testbit(x, i)) } setbitv <- function(xx, ii, v) { .Call(graph_bitarray_set, xx, ii, v) } ## can we vectorize these? setbit <- function(xx, ii) { i <- ii - 1L byteIdx <- (i %/% 8L) + 1L bit <- (i %% 8L) byte <- xx[byteIdx] xx[byteIdx] <- byte | rawShift(as.raw(1L), bit) xx } testbit <- function(xx, ii) { i <- ii - 1L byteIdx <- (i %/% 8L) + 1L bit <- (i %% 8L) byte <- xx[byteIdx] ans <- logical(length(byte)) for (i in seq_len(length(ans))) { ans[i] <- as.logical(byte[i] & rawShift(as.raw(1L), bit[i])) } ans } sumbits <- function(xx, ii) { s <- 0L i <- ii - 1L byteIdx <- (i %/% 8L) + 1L bit <- (i %% 8L) byte <- xx[byteIdx] for (i in seq_len(length(byte))) { s <- s + as.logical(byte[i] & rawShift(as.raw(1L), bit[i])) } s } bitToInteger <- function(x) { len <- attr(x, "bitlen") if (is.null(len)) len <- length(x) * 8L sapply(seq_len(len), function(i) if (testbit(x, i)) 1L else 0L) } bitToMat <- function(x) { len <- attr(x, "bitlen") bitdim <- attr(x, "bitdim") matrix(sapply(seq_len(len), function(i) if (testbit(x, i)) 1L else 0L), nrow = bitdim[1L], ncol = bitdim[2L]) } graph/R/MultiGraph.R0000644000175000017500000016737114136046755014137 0ustar nileshnileshMultiGraph <- function(edgeSets, nodes = NULL, directed = TRUE, ignore_dup_edges = FALSE) { .mg_validate_edgeSet(edgeSets) nodeNames <- .mg_node_names(edgeSets, nodes) n_nodes <- length(nodeNames) edge_sets <- makeMDEdgeSets(edgeSets, directed, nodeNames, ignore_dup_edges = ignore_dup_edges) mg <- new("MultiGraph", edge_sets = edge_sets, nodes = nodeNames) mg@edge_defaults <- sapply(names(edge_sets), function(x) { list("weight" = 1L) }, simplify = FALSE) mg } makeMDEdgeSets <- function(edgeSets, directed, nodes, ignore_dup_edges = FALSE) { directed <- if (length(directed) == 1L) rep(directed, length(edgeSets)) else if (length(directed) != length(edgeSets)) stop("'directed' must align with 'edgeSets' or have length one", call. = FALSE) else directed ans <- vector(mode = "list", length = length(edgeSets)) nms <- names(edgeSets) names(ans) <- nms for (i in seq_along(edgeSets)) { ans[[i]] <- .makeMDEdgeSet(nms[[i]], edgeSets[[i]], directed[[i]], nodes, ignore_dup_edges = ignore_dup_edges) } ans } .makeMDEdgeSet <- function(es_name, es, is_directed, nodes, ignore_dup_edges = FALSE) { if (!all(c("from", "to", "weight") %in% names(es))) stop("'edgeSets' must have columns 'from', 'to', 'weight'", call. = FALSE) n_nodes <- length(nodes) bitVect <- makebits(n_nodes * n_nodes, bitdim = c(n_nodes, n_nodes)) weights <- numeric(0L) if (nrow(es) > 0L) { from <- as.character(es[["from"]]) to <- as.character(es[["to"]]) weights <- es[["weight"]] if (!is_directed) { tmp <- .mg_undirectEdges(from, to, weights) from <- tmp[["from"]] to <- tmp[["to"]] weights <- tmp[["weight"]] } ## map 'from', 'to' from character to integer indicies from_i <- match(from, nodes) to_i <- match(to, nodes) edge_order <- order(to_i, from_i) weights <- weights[edge_order] if (!is.numeric(weights)) stop("'weight' column must be numeric", call. = FALSE) if (ignore_dup_edges) { ## NB: we only consider nodes for duplication, ignoring ## weight value. ft <- cbind(from_i, to_i)[edge_order, , drop=FALSE] tmp <- paste(ft[,"from_i"],ft[,"to_i"], sep="_") want <- !duplicated(tmp) from_i <- ft[want, 1] to_i <- ft[want, 2] weights <- weights[want] } else { from_i <- from_i[edge_order] to_i <- to_i[edge_order] } ## TODO: should not have to pass vector of 1s for each edge in ## setBitCell. bitVect <- setBitCell(bitVect, from_i, to_i, rep(1L, length(from_i))) edge_count <- nbitset(bitVect) if (length(from_i) != edge_count) .report_duplicate_edges(es_name, from, to, is_directed) } klass <- if (is_directed) "DiEdgeSet" else "UEdgeSet" ## FIXME: need to handle extra edge attributes. These will need to ## come in as a separate argument as a list of attribute lists that ## align with from/to new(klass, bit_vector = bitVect, weights = weights, edge_attrs = list()) } .report_duplicate_edges <- function(name, from, to, directed) { df <- cbind(from, to) sep <- if (directed) "=>" else "=" if (any(dups <- duplicated(df))) { stop("duplicate edges in edge set ", sQuote(name), ": ", pasteq(paste(from[dups], to[dups], sep = sep)), call. = FALSE) } } .mg_undirectEdges <- function(from, to, weight) { fromIsFirst <- from < to toIsFirst <- !fromIsFirst tmpFrom <- c(from[fromIsFirst], to[toIsFirst]) tmpTo <- c(to[fromIsFirst], from[toIsFirst]) tmpW <- c(weight[fromIsFirst], weight[toIsFirst]) list(from = tmpFrom, to = tmpTo, weight = tmpW) } .mg_validate_node_names <- function(nodeNames) { if (!all(valid <- .mg_valid_node_names(nodeNames))) { stop("invalid node names: ", pasteq(head(nodeNames[!valid], 10L)), call. = FALSE) } } .mg_node_names <- function(edgeSets, nodes) { ## XXX: we sort the node names and are thus subject ## to locale variation ftSets <- lapply(edgeSets, function(ft) { cbind(from = as.character(ft[["from"]]), to = as.character(ft[["to"]])) }) nodeNames <- unique(c(unlist(ftSets, use.names = FALSE), nodes)) if (is.null(nodeNames) || length(nodeNames) == 0L) nodeNames <- character(0) else { nodeNames <- sort(nodeNames, na.last = FALSE) .mg_validate_node_names(nodeNames) } nodeNames } .mg_validate_edgeSet <- function(edgeSets) { if (!is.list(edgeSets)) stop("'edgeSets' must be a named list or empty list", call. = FALSE) if (length(edgeSets) > 0L) { nms <- names(edgeSets) if (is.null(nms)) stop("'edgeSets' must be a named list", call. = FALSE) if (!all(nzchar(nms)) || any(is.na(nms)) || any(duplicated(nms))) stop("names(edgeSets) is invalid", call. = FALSE) } } MultiDiGraph <- function(edgeSets, nodes = NULL) { ## Nodes are stored in sorted order. The sparse Edge index vector ## is stored in sorted index order. Since R is column-major, this ## means that when translated to x, y coordinates, the ordering is ## sorted by column and then row. ## edgeSets is a list of from/to matrices ftSets <- lapply(edgeSets, function(ft) { cbind(from = as.character(ft[[1L]]), to = as.character(ft[[2L]])) }) nodeNames <- sort(unique(c(unlist(ftSets, use.names = FALSE), nodes)), na.last = FALSE) if (!all(valid <- .mg_valid_node_names(nodeNames))) { stop("node names invalid: ", pasteq(head(nodeNames[!valid], 10L))) } n_nodes <- length(nodeNames) if (n_nodes > 2^15) n_nodes <- as.double(n_nodes) n_edgeSets <- length(edgeSets) es_names <- names(edgeSets) edgeAttrs <- structure(vector("list", n_edgeSets), names = es_names) ## FIXME: should we enforce having a "weight" column? for (i in seq_len(n_edgeSets)) { ft <- ftSets[[i]] from_i <- match(ft[, 1L], nodeNames) to_i <- match(ft[, 2L], nodeNames) sparseAM <- .coordToIndex(from_i, to_i, n_nodes) edgeIdxOrder <- order(sparseAM) esi <- edgeSets[[i]] edgeAttrs[[i]] <- structure(data.frame(mdg_edge_index = sparseAM[edgeIdxOrder], esi[edgeIdxOrder, c(-1L, -2L)], row.names = NULL, stringsAsFactors = TRUE), names = c("mdg_edge_index", names(esi)[-(1:2)])) } new("MultiDiGraph", nodes = nodeNames, edgeAttrs = edgeAttrs) } .mg_valid_node_names <- function(names) { !(is.na(names) | (sapply(names, nchar) == 0) | (regexpr("\\||\n|\t", names) > 0)) } setMethod("numNodes", signature = signature(object = "MultiGraph"), function(object) { length(object@nodes) }) setMethod("numEdges", signature = signature(object = "MultiGraph"), function(object) { ## TODO: would it make more sense to just ## return the length of @weights? sapply(object@edge_sets, function(es) { nbitset(es@bit_vector) }) }) setMethod("nodes", signature = signature(object = "MultiGraph"), function(object, ...) { object@nodes }) setMethod("isDirected", signature = signature(object = "MultiGraph"), function(object) sapply(object@edge_sets, isDirected)) setMethod("isDirected", signature = signature(object = "DiEdgeSet"), function(object) TRUE) setMethod("isDirected", signature = signature(object = "UEdgeSet"), function(object) FALSE) setMethod("ugraph", signature = signature(graph = "MultiGraph"), function(graph) { graph@edge_sets <- lapply(graph@edge_sets, ugraph) graph }) ## FIXME: should ugraph on an undirected graph also drop ## attributes to keep things consistent? setMethod("ugraph", "UEdgeSet", function(graph) { new("UEdgeSet", bit_vector = graph@bit_vector, weights = rep(1L, length(graph@weights)), edge_attrs = list()) }) setMethod("ugraph", "DiEdgeSet", function(graph) { ## XXX: edge weights => 1, edge attributes dropped bit_vector <- .Call(graph_bitarray_undirect, graph@bit_vector) new("UEdgeSet", bit_vector = bit_vector, weights = rep(1L, nbitset(bit_vector)), edge_attrs = list()) }) setMethod("show", signature = signature(object = "MultiGraph"), function(object) { cat(class(object), sprintf("with %d nodes and %d edge sets\n", numNodes(object), length(object@edge_sets))) if (length(object@edge_sets)) { edgeCounts <- numEdges(object) df <- data.frame(edge_set = names(edgeCounts), directed = sapply(object@edge_sets, isDirected), edge_count = edgeCounts, stringsAsFactors = FALSE, row.names = NULL) print(head(df, 10L), row.names = FALSE) } invisible(NULL) }) eweights <- function(object, names.sep = NULL) { if (is.null(names.sep)) { lapply(object@edge_sets, function(es) { es@weights }) } else { sep <- names.sep[1] nn <- nodes(object) n_nodes <- length(object@nodes) lapply(object@edge_sets, function(es) { w <- es@weights ft <- .Call(graph_bitarray_rowColPos, es@bit_vector) names(w) <- paste(nn[ft[, "from"]], nn[ft[, "to"]], sep = names.sep) w }) } } # # edgeMatrices <- function(object) # { # n_nodes <- length(object@nodes) # lapply(object@edgeAttrs, function(attrs) { # matrix(t(.indexToCoord(attrs[[1L]], n_nodes)), # nrow = 2L, # dimnames = list(c("from", "to"), NULL)) # }) # } # # fromToList <- function(object) # { # nodeNames <- object@nodes # n_nodes <- length(nodeNames) # lapply(object@edgeAttrs, function(attrs) { # coord <- .indexToCoord(attrs[[1L]], n_nodes) # coord[] <- nodeNames[coord] # ft <- structure(data.frame(from = coord[ , 1L], to = coord[ , 2L], # attrs[-1L], stringsAsFactors = FALSE), # names = c("from", "to", names(attrs)[-1L])) # ft # }) # } # # # extractGraph <- function(object, which) # { # if (length(which) != 1L) # stop("'which' must be length one") # edgeAttr <- object@edgeAttrs[[which]] # nodeNames <- nodes(object) # ftmat <- .indexToCoord(edgeAttr[[1L]], length(nodeNames)) # ftmat[] <- nodeNames[ftmat] # ftM2graphNEL(ftmat, W = edgeAttr[[2L]], V = nodeNames, # edgemode = "directed") # } # ## Generate a random from/to table ## ## Returns a list with two elements: ## $node: character vector of node labels ## $ft: a data.frame with columns 'from', 'to', and 'weight' ## randFromTo <- function(numNodes, numEdges, weightFun = function(N) rep(1L, N), directed = TRUE) { if (numNodes > 2^15) numNodes <- as.double(numNodes) maxEdges <- numNodes * numNodes nodeNames <- sprintf("%010d", seq_len(numNodes)) ## use double to allow for large numNodes numToGen <- max(numEdges * 4, numNodes) idx <- unique(ceiling(runif(numToGen, min = 0, max = maxEdges))) stopifnot(length(idx) >= numEdges) idx <- idx[seq_len(numEdges)] to_i <- ((idx - 1L) %/% numNodes) + 1L from_i <- ((idx - 1L) %% numNodes) + 1L from <- nodeNames[from_i] to <- nodeNames[to_i] w <- weightFun(length(from)) list(nodes = nodeNames, ft = data.frame(from = from, to = to, weight = w, stringsAsFactors = FALSE)) } oneWeights <- function(x) rep(1L, nrow(x)) edgeSetIntersect0 <- function(g, edgeFun = NULL) { edge_sets <- g@edge_sets n_sets <- length(edge_sets) if (n_sets < 2L) return(g) nms <- names(edge_sets) nName <- paste(nms, collapse = "_") funList <- structure(list(edgeFun), names = nName) directed <- isDirected(g) klass <- if (all(directed)) "DiEdgeSet" else "UEdgeSet" if(!( all(directed) || all(!directed))) { stop("all edges must either be directed or undirected") } g1 <- subsetEdgeSets(g,nms[1]) names(g1@edge_sets) <- names(g1@edge_defaults) <- nName if(length(g1@userAttrPos@edgePos)) names(g1@userAttrPos@edgePos) <- nName for ( i in seq.int(2L, n_sets)) { g2 <- subsetEdgeSets(g, nms[i]) names(g2@edge_sets) <- names(g2@edge_defaults) <- nName if(length(g2@userAttrPos@edgePos)) names(g2@userAttrPos@edgePos) <- nName g1 <- graphIntersect(g1, g2, edgeFun = funList) } n_edges <- attr(g1@edge_sets[[1L]], "nbitset") <- .Call(graph_bitarray_sum, g1@edge_sets[[1L]]@bit_vector ) if(n_edges >0) { return(g1) } else { new_edge_sets <- list() return(new("MultiGraph", edge_sets = new_edge_sets, nodes = nodes(g1))) } } edgeSetUnion0 <- function(g, edgeFun = NULL) { edge_sets <- g@edge_sets n_sets <- length(edge_sets) if (n_sets < 2L) return(g) nms <- names(edge_sets) nName <- paste(names(edge_sets), collapse = "_") funList <- structure(list(edgeFun), names = nms[1]) directed <- isDirected(g) klass <- if (all(directed)) "DiEdgeSet" else "UEdgeSet" if(!( all(directed) || all(!directed))) { stop("all edges must either be directed or undirected") } g1 <- subsetEdgeSets(g,nms[1]) names(g1@edge_sets) <- nName for ( i in seq.int(2L, n_sets)) { g2 <- subsetEdgeSets(g, names(g@edge_sets)[i]) names(g2@edge_sets) <- nName g1 <- graphUnion(g1, g2, funList) } n_edges <- attr(g1@edge_sets[[1L]], "nbitset") <- .Call(graph_bitarray_sum, g1@edge_sets[[1L]]@bit_vector ) if(n_edges >0) { return(g1) } else { new_edge_sets <- list() return(new("MultiGraph", edge_sets = new_edge_sets, nodes = nodes(g1))) } } ## TODO: should you be allowed to rename edge sets? ## or at least name unnamed edge sets? subsetEdgeSets <- function(object, edgeSets) { if (!all(nzchar(edgeSets)) || any(is.na(edgeSets)) || !(all(edgeSets %in% names(object@edge_sets)))) stop("'edgeSet' is invalid") if(any(dups <- duplicated(edgeSets))) stop("duplicate edges specified in edge set ", edgeSets[dups]) object@edge_sets<- object@edge_sets[edgeSets] nms <- names(object@edge_defaults) mtch <- edgeSets[edgeSets %in% nms] object@edge_defaults <- if (length(mtch)) object@edge_defaults[mtch] else list() nms <- names( object@userAttrPos@edgePos) mtch <- edgeSets[edgeSets %in% nms] object@userAttrPos@edgePos <- if (length(mtch))object@userAttrPos@edgePos[mtch] else list() object } diEdgeSetToDataFrame <- function(edgeSets,nodes) { bitvec <- edgeSets@bit_vector df <- .Call(graph_bitarray_rowColPos, bitvec) data.frame(from = nodes[df[, "from"]], to = nodes[df[, "to"]], weight = edgeSets@weights, stringsAsFactors = TRUE) } .extractFromTo_mg <- function(g) { nn <- nodes(g) lapply(g@edge_sets, function(x) diEdgeSetToDataFrame(x, nn)) } setMethod("extractFromTo", "MultiGraph", .extractFromTo_mg) .mgDegree <- function(object) { nn <- nodes(object) len <- length(nn) idx_str <- as.character(seq_len(len)) lapply(object@edge_sets, function(edgeSet) { bitvec <- edgeSet@bit_vector df <- .Call(graph_bitarray_rowColPos, bitvec) tbl <- structure(table(df[, "from"]), class=NULL) indx <- idx_str %in% names(tbl) from <- to <- structure(rep(0, len), names=nn) from[indx] <- tbl tbl <- structure(table(df[, "to"]), class=NULL) indx <- idx_str %in% names(tbl) to[indx] <- tbl if (isDirected(edgeSet)) { list(inDegree = to, outDegree = from) } else { degree = from + to } }) } setMethod("subGraph", signature(snodes="character", graph="MultiGraph"), function(snodes, graph) { origNodes <- nodes(graph) snodes <- sort(snodes) snodesIdx <- match(snodes, origNodes) if (any(is.na(snodesIdx))) { bad <- snodes[which(is.na(snodesIdx))] stop("'snodes' contains nodes not in MultiGraph: ", pasteq(bad)) } nms <- names(graph@nodeData@defaults) len <- length(snodes) tmp <- makebits(len) for(i in nms){ indx <- bitToLogical(graph@userAttrPos@nodePos[[i]])[snodesIdx] graph@nodeData@data[[i]] <- .getNodeAttrVec(graph, i)[snodesIdx][indx] graph@userAttrPos@nodePos[[i]] <- setbitv(tmp, which(indx), rep(1L, length(which(indx)))) } graph@nodes <- snodes edgNms <- names(graph@edge_sets) for(i in edgNms) { res <- .Call(graph_bitarray_subGraph, graph@edge_sets[[i]]@bit_vector, snodesIdx) graph@edge_sets[[i]]@bit_vector <- res$bitVec graph@edge_sets[[i]]@weights <- graph@edge_sets[[i]]@weights[res$setPos] attrNms <- names(graph@edge_sets[[i]]@edge_attrs) for (j in attrNms) { attrBit <- graph@userAttrPos@edgePos[[i]][[j]] res <- .Call(graph_bitarray_subGraph, attrBit, snodesIdx) graph@edge_sets[[i]]@edge_attrs[[j]] <- graph@edge_sets[[i]]@edge_attrs[[j]][res$setPos] graph@userAttrPos@edgePos[[i]][[j]] <- res$bitVec } } graph }) extractGraphAM <- function(g, edgeSets) { if(missing(edgeSets)) edgeSets <- names(g@edge_sets) if (!all(nzchar(edgeSets)) || any(is.na(edgeSets)) || !(all(edgeSets %in% names(g@edge_sets)))) stop("'edgeSet' is invalid") nds <- nodes(g) drct <- isDirected(g) esets <- if (missing(edgeSets)) g@edge_sets else g@edge_sets[edgeSets] nms <- names(esets) names(nms) <- nms lapply(nms, function(x) { mat <- edgeSetToMatrix(nds, esets[[x]], drct[[x]]) bam <- graphAM(adjMat=mat, edgemode = if(drct[[x]]) "directed" else "undirected", values= list(weight = esets[[x]]@weights)) }) } edgeSetToMatrix <- function(nds, edgeSet, directed) { .Call(graph_bitarray_edgeSetToMatrix, nds, edgeSet@bit_vector, as.numeric(edgeSet@weights), as.logical(directed)) } setMethod("graphIntersect", c("MultiGraph", "MultiGraph"), function(x, y, nodeFun, edgeFun, ...){ nn <- intersect(nodes(x), nodes(y)) nnLen <- length(nn) nmsX <- names(x@edge_sets) nmsY <- names(y@edge_sets) eg <- intersect(nmsX, nmsY) dr1 <- isDirected(x)[eg] dr2 <- isDirected(y)[eg] if(!all(dr1 == dr2)) stop("edgeSets 'x' and 'y' must have same edgemode") theMode <- dr1 & dr2 if (nnLen == 0){ ft <- data.frame(from = character(0), to = character(0), weight = numeric(0), stringsAsFactors = TRUE) es <- structure(rep(list(ft), length(eg)), names = eg) mg <- MultiGraph(es, directed = theMode) return(mg) } x <- subsetEdgeSets(x, eg) y <- subsetEdgeSets(y, eg) sgx <- if (nnLen == numNodes(x)) x else subGraph(nn, x) sgy <- if (nnLen == numNodes(y)) y else subGraph(nn, y) if(missing(edgeFun)) edgeFun <- structure( rep(list(NULL),length(eg)), names = eg) if(missing(nodeFun)) nodeFun <- NULL new_edge_sets <- structure(lapply(eg, function(k) { .getEdgeIntersect(sgx@edge_sets[[k]], sgy@edge_sets[[k]]) }), names = eg) mg <- .getMGIntersect(sgx, sgy, new_edge_sets, edgeFun) mg@nodeData@defaults <- .retNodeIntersectDefaults(sgx, sgy) mg@userAttrPos@nodePos <- .getIntNodeUserAttrPos(sgx, sgy) mg@nodeData@data <- .nodeIntersect(sgx, sgy, mg, nodeFun) mg }) .getMGIntersect <- function(g1, g2, edge_set, edgeFun) { nn <- intersect(nodes(g1), nodes(g2)) ans <- new("MultiGraph", edge_sets = edge_set, nodes = nn) eg <- intersect(names(g1@edge_sets), names(g2@edge_sets)) for( i in eg) { e1Attr <- names(g1@edge_sets[[i]]@edge_attrs) e2Attr <- names(g2@edge_sets[[i]]@edge_attrs) commonAttr <- intersect(e1Attr, e2Attr) funList <- edgeFun[[i]] if(!is.null(funList)) { fIndx <- names(funList) %in% c(commonAttr, "weight") if(!all(fIndx)) stop("attributes in 'funList' not in edge attributes: ", pasteq(names(funList)[fIndx])) } attrType <- .Call(graph_bitarray_Intersect_Attrs, edge_set[[i]]@bit_vector, g1@edge_sets[[i]]@bit_vector, g2@edge_sets[[i]]@bit_vector) if(length(attrType$from) >0) { ans@edge_sets[[i]]@weights <- .getIntersectAttrs("weight", attrType, g1@edge_sets[[i]]@weights, g2@edge_sets[[i]]@weights, funList) } bt <- (g1@edge_sets[[i]]@bit_vector) & (g2@edge_sets[[i]]@bit_vector) attributes(bt) <- attributes(g1@edge_sets[[i]]@bit_vector) ns <- .Call(graph_bitarray_sum, bt) attr(bt, "nbitset") <- ns for(j in commonAttr) { ans@userAttrPos@edgePos[[i]][[j]] <- bt xAttr <- .retMGAttrVec(g1, i, j) yAttr <- .retMGAttrVec(g2, i, j) if(length(attrType$from) >0) { ans@edge_sets[[i]]@edge_attrs[[j]] <- .getIntersectAttrs(j, attrType, xAttr, yAttr, funList) } } ans@edge_defaults[[i]]<- .retEdgeIntersectDefaults(g1@edge_defaults[[i]], g2@edge_defaults[[i]]) } ans } .scaleMG <- function(g, theNodes) { if (all(nodes(g) %in% theNodes) && length(nodes(g)) == length(theNodes)) return(g) else { es <- names(g@edge_sets) for (i in es) { g@edge_sets[[i]] <- .scaleEdgeSet(g, i, theNodes) nms <- names(g@userAttrPos@edgePos[[i]]) for(j in nms) { g@userAttrPos@edgePos[[i]][[j]] <- .scaleUserAttrPos(g@userAttrPos@edgePos[[i]][[j]], theNodes) } } } nms <- names(g@nodeData@defaults) for(i in nms){ origNds <- nodes(g)[(bitToLogical(g@userAttrPos@nodePos[[i]]))] ndsLen <- length(theNodes) indx <- match(origNds, theNodes) bt <- makebits(ndsLen) bt <- setbitv(bt, indx, rep(1L, length(indx))) g@userAttrPos@nodePos[[i]] <- bt g@nodeData@data[[i]] <- g@nodeData@data[[i]] } g@nodes <- theNodes g } .scaleUserAttrPos <- function(edgePos, nds) { ft <- .Call(graph_bitarray_rowColPos, edgePos) ndsLen <- length(nds) posBit <- .createZeroBitPos(ndsLen) setBitCell(posBit, ft[,"from"], ft[,"to"], rep(1L, nrow(ft))) } .scaleEdgeSet <- function(g, es, nds) { df <- diEdgeSetToDataFrame(g@edge_sets[[es]], nodes(g)) edge_sets <- .makeMDEdgeSet(es_name = 1, es = df, is_directed = isDirected(g@edge_sets[[es]]), nds, ignore_dup_edges = FALSE) edge_sets@edge_attrs <- g@edge_sets[[es]]@edge_attrs edge_sets } .retMGEdgeUnionUserAttrPos <- function(x, y) { nmsX <- names(x@edge_sets) nmsY <- names(y@edge_sets) cmnEdges <- intersect(nmsX, nmsY) allEdges <- union(nmsX, nmsY) snglEdges <- allEdges[! allEdges %in% cmnEdges] ans <- structure(vector(mode = "list", length(allEdges)), names = allEdges) for(i in cmnEdges) { xAttr <- names(x@edge_sets[[i]]@edge_attrs) yAttr <- names(y@edge_sets[[i]]@edge_attrs) unionAttrs <- unique(union(xAttr, yAttr)) commonAttrs <- intersect(xAttr,yAttr) singleAttrs <- unionAttrs[!unionAttrs %in% commonAttrs] ans[[i]] <- structure(vector(mode = "list", length(unionAttrs)), names = unionAttrs) bt <- (x@edge_sets[[i]]@bit_vector) | (y@edge_sets[[i]]@bit_vector) attributes(bt) <- attributes(x@edge_sets[[i]]@bit_vector) ns <- .Call(graph_bitarray_sum, bt) attr(bt, "nbitset") <- ns for (j in commonAttrs) { ans[[i]][[j]] <- bt } for(j in singleAttrs) { if(j %in% names(x@edge_sets[[i]])) ans[[i]][[j]] <- x@userAttrPos@edgePos[[i]][[j]] else ans[[i]][[j]] <- y@userAttrPos@edgePos[[i]][[j]] } } for(i in snglEdges) { if(i %in% names(x@edge_sets)) ans[[i]] <- x@userAttrPos@edgePos[[i]] else ans[[i]] <- y@userAttrPos@edgePos[[i]] } ans } .getUnionEdgeSet <- function(g1, g2, edgeFun) { eg <- intersect(names(g1@edge_sets),names(g2@edge_sets)) theNodes <- unique(c(nodes(g1), nodes(g2))) edge_sets <- structure(lapply(eg, function(i) { e1Attr <- names(g1@edge_sets[[i]]@edge_attrs) e2Attr <- names(g2@edge_sets[[i]]@edge_attrs) unionAttr <- unique(union(e1Attr, e2Attr)) if(!is.null(edgeFun[[i]])) { fIndx <- names(edgeFun[[i]]) %in% c(unionAttr, "weight") if(!all(fIndx)) stop("attributes in 'edgeFun' not in edge attributes: ", pasteq(names(edgeFun[[i]])[fIndx])) } bv <- g1@edge_sets[[i]]@bit_vector | g2@edge_sets[[i]]@bit_vector attributes(bv) <- attributes(g1@edge_sets[[i]]@bit_vector) attr(bv, "nbitset") <- ns <- .Call(graph_bitarray_sum, bv) dr1 <- isDirected(g1@edge_sets[[i]]) dr2 <- isDirected(g2@edge_sets[[i]]) theMode <- if (dr1 && dr2) "directed" else "undirected" c0 <- character(0) df <- data.frame(from = c0, to = c0, weight = numeric(0), stringsAsFactors = TRUE) edge_set <- .makeMDEdgeSet(es_name = 1, es =df, is_directed = (theMode == "directed"), nodes = theNodes, ignore_dup_edges = FALSE) edge_set@bit_vector <- bv cmnBit <- g1@edge_sets[[i]]@bit_vector & g2@edge_sets[[i]]@bit_vector attributes(cmnBit) <- attributes(g1@edge_sets[[i]]@bit_vector) attr(cmnBit, "nbitset") <- .Call(graph_bitarray_sum, cmnBit) fromOneBit <- g1@edge_sets[[i]]@bit_vector & (!cmnBit) attributes(fromOneBit) <- attributes(g1@edge_sets[[i]]@bit_vector) attr(fromOneBit, "nbitset") <- .Call(graph_bitarray_sum, fromOneBit) fromTwoBit <- g2@edge_sets[[i]]@bit_vector & (!cmnBit) attributes(fromTwoBit) <- attributes(g2@edge_sets[[i]]@bit_vector) attr(fromTwoBit, "nbitset") <- .Call(graph_bitarray_sum, fromTwoBit) attrType <- .Call(graph_bitarray_Union_Attrs, bv, cmnBit, fromOneBit, fromTwoBit) if(length(attrType$from) >0) { edge_set@weights <- as.numeric(.getMGUnionWeights(attrType, g1, g2, i, edgeFun[[i]])) } if(!is.null(unionAttr)) { for(j in unionAttr) { edge_set@edge_attrs[[j]] <- .getMGUnionAttrs(j, attrType, g1, g2, i, edgeFun[[i]]) } } edge_set }), names = eg) edge_sets } .getMGUnionWeights <- function(attrType, g1, g2, es, funList) { len <- length(attrType$from) attr1 <- vector(len, mode = "numeric") attr1[seq_len(len)] <- NA ## from x k <- (as.numeric(attrType$from) ==1) attr1[k] <- g1@edge_sets[[es]]@weights[attrType$indx1[k]] ## from y k <- (as.numeric(attrType$from) == 2) attr1[k] <- g2@edge_sets[[es]]@weights[attrType$indx2[k]] ## resolve union k <- (as.numeric(attrType$from) ==0) if(any(k)) { val1 <- g1@edge_sets[[es]]@weights[attrType$indx1[k]] val2 <- g2@edge_sets[[es]]@weights[attrType$indx2[k]] if(!is.null(funList) && ("weight" %in% names(funList))) { attr1[k] <- sapply(seq_len(sum(k)), function(p) { return(funList[["weight"]](val1[[p]], val2[[p]])) }) } else if(is.vector(val1) && is.vector(val2)) { eqInd <- sapply(seq_len(length(val1)), function(x){ identical(val1[x], val2[x]) }) pt <- which(eqInd) lp <- length(which(k)) tmp <- vector(lp, mode ="numeric") tmp[seq_len(lp)] <- NA tmp[pt] <- val1[pt] attr1[k] <- tmp } } attr1 } .getMGUnionAttrs <- function(att, attrType, x , y, es, funList ) { len <- length(attrType$from) indx <- as.numeric(attrType$from) if(att %in% names(x@edge_sets[[es]]@edge_attrs)) mds <- mode(x@edge_sets[[es]]@edge_attrs[[att]]) else if(att %in% names(y@edge_sets[[es]]@edge_attrs)) mds <- mode(y@edge_sets[[es]]@edge_attrs[[att]]) attr1 <- vector(len , mode = mds) attr1[seq_len(len)] <- NA ## from x k <- (as.numeric(attrType$from) ==1) if(att %in% names(x@edge_sets[[es]]@edge_attrs)) { xAttr <- .retMGAttrVec(x, es, att) attr1[k] <- xAttr[ attrType$indx1[k]] } ## from y k <- (as.numeric(attrType$from) == 2) if(att %in% names(y@edge_sets[[es]]@edge_attrs)) { yAttr <- .retMGAttrVec(y, es, att) attr1[k] <- yAttr[ attrType$indx2[k]] } ## resolve union k <- (as.numeric(attrType$from) ==0) if(any(k)) { if(att %in% names(x@edge_sets[[es]]@edge_attrs)) val1 <- xAttr[ attrType$indx1[k]] else val1 <- yAttr[ attrType$indx2[k]] if(att %in% names(y@edge_sets[[es]]@edge_attrs)) val2 <- yAttr[ attrType$indx2[k]] else val2 <- xAttr[ attrType$indx1[k]] if(!is.null(funList) && (att %in% names(funList))) { attr1[k] <- sapply(seq_len(sum(k)), function(p) { return(funList[[att]](val1[[p]], val2[[p]])) }) } else if (is.vector(val1) && is.vector(val2)) { eqInd <- sapply(seq_len(length(val1)), function(x){ identical(val1[x], val2[x]) }) pt <- which(eqInd) lp <- sum(k) tmp <- vector(lp, mode = mds) tmp[seq_len(lp)] <- NA tmp[pt] <- val1[pt] attr1[k] <- tmp } } attr1 } setMethod("graphUnion", c("MultiGraph", "MultiGraph"), function(x, y, nodeFun, edgeFun, ...){ dr1 <- isDirected(x) dr2 <- isDirected(y) nmsX <- names(x@edge_sets) nmsY <- names(y@edge_sets) eg <- intersect(nmsX, nmsY) if(missing(edgeFun)) edgeFun <- structure( rep(list(NULL),length(eg)), names = eg) if(missing(nodeFun)) nodeFun <- NULL if(!all(dr1[eg] == dr2[eg])) stop("edgeSets 'x' and 'y' must have same edgemode") theNodes <- unique(c(nodes(x), nodes(y))) nnLen <- length(theNodes) mgx <- .scaleMG(x, theNodes) mgy <- .scaleMG(y, theNodes) xeg <- nmsX[ !nmsX %in% eg] yeg <- nmsY[ !nmsY %in% eg] new_edge_sets <- .getUnionEdgeSet(mgx, mgy, edgeFun) x_edge_sets <- x@edge_sets[xeg] y_edge_sets <- y@edge_sets[yeg] mg <- new("MultiGraph", edge_sets = c(new_edge_sets, x_edge_sets, y_edge_sets), nodes = theNodes) mg@userAttrPos@edgePos <- .retMGEdgeUnionUserAttrPos(mgx, mgy) mg@nodeData@defaults <- .retNodeUnionDefaults(mgx, mgy) mg@nodeData@data <- .nodeUnion(x, y, nodeFun) mg@userAttrPos@nodePos <- .getUnionNodeUserAttrPos(mg, mgx, mgy) mg@edge_defaults <- .retMGEdgeUnionDefaults(mgx, mgy) mg }) .retMGEdgeUnionDefaults <- function(g1, g2) { eg <- intersect(names(g1@edge_sets), names(g2@edge_sets)) structure(lapply(eg, function(i) { cmnAttrs <- intersect(names(g1@edge_defaults[[i]]), names(g2@edge_defaults[[i]])) unqAttrs <- unique(c(names(g1@edge_defaults[[i]]), names(g2@edge_defaults[[i]]))) singleAttrs <- unqAttrs[!( unqAttrs %in% cmnAttrs)] cmn <- structure(lapply(cmnAttrs, function(x) { if(identical(g1@edge_defaults[[i]][[x]], g2@edge_defaults[[i]][[x]])) g1@edge_defaults[[i]][[x]] else NA }), names = cmnAttrs) sng <- structure(lapply(singleAttrs, function(x) { if(x %in% names(g1@edge_defaults[[i]])) g1@edge_defaults[[i]][[x]] else g2@edge_defaults[[i]][[x]] }), names = singleAttrs) c(cmn, sng) }), names = eg) } extractGraphBAM <- function(g, edgeSets) { if(missing(edgeSets)) edgeSets <- names(g@edge_sets) if (!all(nzchar(edgeSets)) || any(is.na(edgeSets)) || !(all(edgeSets %in% names(g@edge_sets)))) stop("edgeSet is invalid") nn <- nodes(g) esets <- g@edge_sets[edgeSets] df_empty <- data.frame(from = character(0), to = character(0), weight = numeric(0), stringsAsFactors = TRUE) structure(lapply(names(esets), function(x) { edgeMode <- if(isDirected(esets[[x]])) "directed" else "undirected" bam <- graphBAM(df_empty, nodes = nn, edgemode = edgeMode, ignore_dup_edges = TRUE) bam@edgeSet <- esets[[x]] bam@nodeData@data <- g@nodeData@data bam@nodeData@defaults <- g@nodeData@defaults bam@userAttrPos@nodePos <- g@userAttrPos@nodePos bam@edgeData@defaults <- g@edge_defaults[[x]] if(length(g@userAttrPos@edgePos)) bam@userAttrPos@edgePos <- g@userAttrPos@edgePos[[x]] bam }), names = names(esets)) } ## Degree of a multigraph setMethod("degree", signature(object = "MultiGraph"), function(object){ .mgDegree(object) }) ## Node data accces methods .nodeDataRetrieve <- function(self, n, attr) { if (length(attr) != 1L) stop("'attr' argument must specify a single attribute name") if ( ! (attr %in% names(self@nodeData@defaults))) stop("attribute not present: ", sQuote(attr)) nds <- nodes(self) .verifyNodes(n, nds) idx <- match(n, nds) names(idx) <- seq_along(idx) idx <- sort(idx) n <- n[as.numeric(names(idx))] names(idx) <- NULL bt <- self@userAttrPos@nodePos[[attr]] ord <- .getNodeAttrPos(bt, idx) res <- vector(length(idx), mode = mode(self@nodeData@defaults[[attr]])) res[seq_along(idx)] <- self@nodeData@defaults[[attr]] if (length(ord$leftPos)) res[ord$leftPos] <- self@nodeData@data[[attr]][ord$rightPos] as.list(structure(res, names = n)) } setMethod("nodeData", signature(self = "MultiGraph", n = "character", attr = "character"), function(self, n, attr) { .nodeDataRetrieve(self, n, attr) }) setMethod("nodeData", signature(self = "MultiGraph", n = "missing", attr = "character"), function(self, n, attr) { if(length(attr) != 1L) stop("'attr' must specify a single attribute") if( ! (attr %in% names(self@nodeData@defaults))) stop("attribute not present: ", sQuote(attr)) nds <- nodes(self) nodeData(self, n= nds, attr= attr) }) setMethod("nodeData", signature(self = "MultiGraph", n = "character", attr = "missing"), function(self, n, attr) { nds <- nodes(self) .verifyNodes(n ,nds) nms <- names(self@nodeData@defaults) structure(lapply(nms, function(x) { nodeData(self, n, x) }), names = nms) }) setMethod("nodeData", signature(self = "MultiGraph", n = "missing", attr = "missing"), function(self, n, attr) { nds <- nodes(self) nms <- names(self@nodeData@defaults) structure(lapply(nms, function(x) { nodeData(self, nds, x) }), names = nms) }) ## Node data replacement methods .nodeDataReplaceNodeGiven <- function(self, n, attr, value) { .verifyAttrName(attr, names(self@nodeData@defaults)) if(length(attr) != 1L) stop("attr argument must specify a single attribute") if(is.vector(value)){ len <- length(value) } else { len <- 1 value <- list(value) } if(len!=1L && len != length(n)) { stop("value must be of length one or have the same length as n") } nms <- names(self@nodeData@data) nds <- nodes(self) .verifyNodes(n, nds) if(len==1L && len !=length(n)) value <- rep(value, length(n)) idx <- match(n, nds) names(idx) <- seq_along(idx) idx <- sort(idx) value <- value[as.numeric(names(idx))] names(idx) <- NULL bt <- self@userAttrPos@nodePos[[attr]] bt <- .Call(graph_bitarray_set, bt, as.integer(idx), as.integer(rep(1L, length(idx)))) ns <- attr(bt, "nbitset") self@userAttrPos@nodePos[[attr]] <- bt ord <- .getNodeAttrOrder(bt, idx) newAttr <- vector(ns, mode = mode(value)) newAttr[attr(ord$newVal, "newPos")] <- value[ord$newVal] newAttr[attr(ord$origVal, "origPos")] <- self@nodeData@data[[attr]][ord$origVal] self@nodeData@data[[attr]] <- newAttr self } .nodeDataReplaceNodeMissing <- function (self, attr, value) { .verifyAttrName(attr, names(self@nodeData@defaults)) if(length(attr) != 1L) stop("attr argument must specify a single attribute") lenNode <- length(nodes(self)) if(is.vector(value)){ lenVal <- length(value) } else { lenVal <- 1 value <- list(value) } if(lenVal !=1L && lenVal != lenNode) { stop("value must be of length one or have the same length as number of nodes of self") } idx <- seq_len(lenNode) nodeData(self, n = nodes(self), attr) <- value self } setReplaceMethod("nodeData", signature(self = "MultiGraph", n="character", attr="character", value="ANY"), function(self, n, attr, value) { .nodeDataReplaceNodeGiven(self, n, attr, value) }) setReplaceMethod("nodeData", signature(self = "MultiGraph", n="missing", attr="character", value="ANY"), function(self, n, attr, value) { .nodeDataReplaceNodeMissing(self, attr, value) }) .verifyMgEdgeSetNames <- function(mg, e) { if(!e %in% names(mg@edge_defaults)) stop("edgeSet not found: ", sQuote(e)) if(numEdges(mg)[e] == 0) stop("edgeSet does not have any connected edges: ", sQuote(e)) } .verifyMgEdges <- function(mg, e, from, to) { stopifnot(length(from) == length(to)) if (length(from) == 0L) stop("edges not in edgeSet: ", sQuote(e)) adjList <- .mgIsAdj(mg, e, from, to) if (any(!adjList)) { badFr <- from[!adjList] badTo <- to[!adjList] res <- paste(badFr, badTo, sep = "|", collapse = ", ") stop("edges not found: ", sQuote(res)) } TRUE } .verifyMGAttrs <- function(mg, e, attr) { if( !(attr %in% names(mg@edge_defaults[[e]]))) stop("attr ", sQuote(attr), " not in edgeSet ", sQuote(e)) } setMethod("mgEdgeDataDefaults", signature(self ="MultiGraph", edgeSet="character", attr="character"), function(self, edgeSet, attr) { self@edge_defaults[[edgeSet]][[attr]] }) setMethod("mgEdgeDataDefaults", signature(self ="MultiGraph", edgeSet="character", attr="missing"), function(self, edgeSet, attr) { self@edge_defaults[[edgeSet]] }) setReplaceMethod("mgEdgeDataDefaults", signature(self="MultiGraph", edgeSet = "character", attr="missing", value="list"), function(self, edgeSet, attr, value) { self@edge_defaults[[edgeSet]] <- value wt <- self@edge_defaults[[edgeSet]][["weights"]] if(!is.numeric(wt) && !is.null(wt)) stop("weights attribute has to be of type numeric") ndsLen <- length(nodes(self)) nms <- names(value) posBit <- .createZeroBitPos(ndsLen) for(i in seq_along(value)) { nms <- names(self@userAttrPos@edgePos[[edgeSet]]) if(!(nms[i] %in% nms)) { if(nms[i] != "weight"){ self@userAttrPos@edgePos[[edgeSet]][[nms[i]]] <- posBit } } } self }) setReplaceMethod("mgEdgeDataDefaults", signature(self="MultiGraph", edgeSet = "character", attr="character", value="ANY"), function(self, edgeSet, attr, value) { self@edge_defaults[[edgeSet]][[attr]] <- value if(attr == "weight") { wt <- self@edge_defaults[[edgeSet]][["weights"]] if(!is.numeric(wt) && !is.null(wt)) stop("weights attribute has to be of type numeric") } else{ ndsLen <- length(nodes(self)) posBit <- .createZeroBitPos(ndsLen) if(!(attr %in% names(self@userAttrPos@edgePos[[edgeSet]]))) { self@userAttrPos@edgePos[[edgeSet]][[attr]] <- posBit } } self }) ## MultiGraph edgeData methods setMethod("mgEdgeData", signature(self = "MultiGraph", edgeSet = "character", from = "character", to = "character", attr = "character"), function(self, edgeSet, from , to, attr) { nodeNames <- self@nodes .verifyMgEdgeSetNames(self, edgeSet) req_ft <- .align_from_to(from, to, nodeNames) if(nrow(req_ft) > 0) .verifyMgEdges(self, edgeSet, req_ft[,"from"], req_ft[,"to"]) .verifyMGAttrs(self, edgeSet, attr) numNodes <- length(nodeNames) bv <- self@edge_sets[[edgeSet]]@bit_vector val <- .retMGAttrVec(self, edgeSet, attr) ft <- .Call(graph_bitarray_rowColPos, self@edge_sets[[edgeSet]]@bit_vector) if(!isDirected(self@edge_sets[[edgeSet]])) { df <- cbind(from=ft[,"to"], to = ft[,"from"]) ft <- rbind(ft,df) val <- c(val, val) } ft <- data.frame(ft, stringsAsFactors = TRUE) ft <- ft[with(ft, order(to,from)),] req_i <- structure(match(req_ft, nodeNames), dim = dim(req_ft)) colnames(req_i) <- c("from", "to") tmp <- rbind(req_i, ft) pst <- paste(tmp[,"from"],tmp[,"to"], sep = "_") idx <- duplicated(pst)[seq(nrow(req_i) +1 , nrow(tmp))] ord <- order(req_i[,2], req_i[,1]) req_i <- req_i[ord,,drop =FALSE] val <- structure(val[idx], names = paste(nodeNames[req_i[,1]],nodeNames[req_i[,2]], sep = "|")) as.list(val) }) setMethod("mgEdgeData", signature(self = "MultiGraph", edgeSet = "character", from = "character", to = "missing", attr = "character"), function(self, edgeSet, from , to, attr) { .verifyMgEdgeSetNames(self,edgeSet) .mgGetAttrs( self, edgeSet, from, attr) }) setMethod("mgEdgeData", signature(self = "MultiGraph", edgeSet = "character", from = "missing", to = "character", attr = "character"), function(self, edgeSet, from , to, attr) { .verifyMgEdgeSetNames(self,edgeSet) nodeNames <- self@nodes numNodes <- length(nodeNames) bv <- self@edge_sets[[edgeSet]]@bit_vector val <- .retMGAttrVec(self, edgeSet, attr) ft <- .Call(graph_bitarray_rowColPos, self@edge_sets[[edgeSet]]@bit_vector) if(!isDirected(self@edge_sets[[edgeSet]])) { df <- cbind(from=ft[,"to"], to = ft[,"from"]) ft <- rbind(ft,df) val <- c(val,val) } tmp <- seq_len(length(val)) ft <- data.frame(ft, tmp, stringsAsFactors = FALSE) ft <- ft[ft[,"to"] %in% which(nodeNames %in% to),] if(nrow(ft) == 0) stop("edges in \"to\" not found in \"self\"") .verifyMgEdges(self, edgeSet, nodeNames[ft[,"from"]], nodeNames[ft[,"to"]]) nodeLbl <- paste( nodeNames[ft[,"from"]], nodeNames[ft[, "to"]], sep ="|") val <- val[ft[,"tmp"]][seq_along(nodeLbl)] names(val) <- nodeLbl as.list(val) }) setMethod("mgEdgeData", signature(self = "MultiGraph", edgeSet = "character", from = "missing", to = "missing", attr = "character"), function(self, edgeSet, from , to, attr) { .verifyMgEdgeSetNames(self,edgeSet) eg <- .edges_mg(self, edgeSet) .mgGetAttrs( self, edgeSet, from = names(eg), attr) }) ## MultiGraph edgeData replacement methods setReplaceMethod("mgEdgeData", signature(self = "MultiGraph", edgeSet = "character", from = "character", to = "character", attr = "character", value = "ANY"), function(self, edgeSet, from, to, attr, value) { .verifyMgEdgeSetNames(self,edgeSet) .verifyAttrName(attr, names(self@edge_defaults[[edgeSet]])) lenFrom <- length(from) lenTo <- length(to) if (lenFrom != lenTo) { if(lenFrom ==1) from <- rep(from, lenTo) else if (lenTo == 1) to <- rep(to , lenFrom) else stop("arguments 'from', 'to' differ in length") } if(length(edgeSet) != 1L) stop("edgeSet has to be of length 1") .mgSetAttrs(self, edgeSet, from, to, attr, value) }) setReplaceMethod("mgEdgeData", signature(self="MultiGraph", edgeSet = "character", from = "character", to = "missing", attr="character", value = "ANY"), function(self, edgeSet, from, to, attr, value) { .verifyAttrName(attr, names(self@edge_defaults[[edgeSet]])) .verifyMgEdgeSetNames(self,edgeSet) eg <- .edges_mg(self, edgeSet)[from] to <- unlist(eg, use.names = FALSE) len <- as.numeric(sapply(eg, length)) from <- rep(names(eg),len) .mgSetAttrs(self, edgeSet, from, to, attr, value) }) setReplaceMethod("mgEdgeData", signature(self="MultiGraph", edgeSet = "character", from="missing", to="character", attr="character", value="ANY"), function(self,edgeSet, from, to, attr, value) { .verifyMgEdgeSetNames(self,edgeSet) eg <- .edges_mg(self, edgeSet, direction = "in") eg <- eg[order(names(eg))][to] from <- unlist(eg, use.names = FALSE) len <- as.numeric(sapply(eg, length)) to <- rep(names(eg), len) .mgSetAttrs(self, edgeSet, from, to, attr, value) }) setReplaceMethod("mgEdgeData", signature(self="MultiGraph", edgeSet = "character", from="missing", to="missing", attr="character", value="ANY"), function(self, edgeSet, from, to, attr, value) { .verifyMgEdgeSetNames(self, edgeSet) nn <- nodes(self) df <- diEdgeSetToDataFrame(self@edge_sets[[edgeSet]], nn) from <- nn[df[,"from"]] to <- nn[df[,"to"]] .mgSetAttrs(self, edgeSet, from, to, attr, value) }) .edges_mg <- function(object, e, direction="out") { nn <- nodes(object) if (numEdges(object)[e] == 0L) { names(nn) <- nn c0 <- character(0L) return(lapply(nn, function(x) c0)) } ft <- .Call(graph_bitarray_rowColPos, object@edge_sets[[e]]@bit_vector) ft[] <- nn[ft] eL <- singles <- NULL if (isDirected(object@edge_sets[[e]])) { if (direction == "in") ft[ , c("from", "to")] <- ft[ , c("to", "from")] eL <- split(ft[ , "to"], ft[ , "from"]) singles <- nn[!(nn %in% ft[ , "from"])] } else { eL <- lapply(split(ft, ft[ , c("to", "from")]), unique) singles <- nn[!(nn %in% ft)] } if (length(singles) > 0) { names(singles) <- singles c0 <- character(0L) empties <- lapply(singles, function(x) c0) eL <- c(eL, empties) } eL[order(names(eL))] } .mgIsAdj <- function(object, e, from, to) { eSpec <- .normalizeEdges(from, to) from <- eSpec$from to <- eSpec$to fromIdx <- match(from, nodes(object), nomatch=0) toIdx <- match(to, nodes(object), nomatch=0) if (any(fromIdx == 0)) stop("unknown nodes in 'from': ", pasteq(from[fromIdx == 0])) if (any(toIdx == 0)) stop("unknown nodes in 'to': ", pasteq(to[toIdx == 0])) fromEdges <- .edges_mg(object, e)[from] .Call(graph_is_adjacent, fromEdges, to) } .mgSetAttrs <- function(mg, e, from, to, attr, value) { nodeNames <- mg@nodes req_ft <- .align_from_to(from, to, nodeNames) ## remove dups indx <- duplicated(paste(req_ft[,"from"], req_ft[,"to"], sep ="_")) req_ft <- req_ft[!indx, ,drop = FALSE] if(nrow(req_ft) > 0) .verifyMgEdges(mg, e, req_ft[,"from"], req_ft[,"to"]) else stop("edges specified could not be found in edgeSet ", sQuote(e)) if(is.vector(value)) { len <- length(value) }else{ len <- 1 value <- list(value) } if(len == 1L) value <- rep(value, nrow(req_ft)) if(length(value) != nrow(req_ft)) stop("number of edges and attribute values must be the same") ft <- .Call(graph_bitarray_rowColPos, mg@edge_sets[[e]]@bit_vector) if (!isDirected(mg@edge_sets[[e]])) { ## normalize from/to valIndx <- seq_len(length(value)) tmp <- .mg_undirectEdges(req_ft[ , 1], req_ft[, 2], valIndx) req_ft <- cbind(tmp[["from"]], tmp[["to"]]) value <- value[tmp[["weight"]]] } ## convert node names to index req_i <- structure(match(req_ft, nodeNames), dim = dim(req_ft)) colnames(req_i) <- c("from", "to") req_i <- data.frame(req_i, stringsAsFactors = TRUE) idx <- order(req_i[,2], req_i[,1]) req_i <- req_i[idx, ] value <- value[idx] if(attr == "weight") { attrBit <- mg@edge_sets[[e]]@bit_vector if(nrow(req_i)) { ord <- .Call(graph_bitarray_getEdgeAttrOrder, attrBit, as.integer(req_i[,"from"]), as.integer(req_i[,"to"])) mg@edge_sets[[e]]@bit_vector <- setBitCell(attrBit, req_i[,"from"], req_i[,"to"], rep(1L, nrow(req_i))) nt <- attr(mg@edge_set[[e]]@bit_vector, "nbitset") } else { nt <- attr(attrBit, "nbitset") ord <- list(newLeftPos = integer(0), newRightPos = integer(0), origLeftPos = seq_len(nt), origRightPos = seq_len(nt)) } newAttr <- vector(nt, mode = mode(value)) newAttr[ord$origLeftPos] <- mg@edgeSet@weights[ord$origRightPos] newAttr[ord$newLeftPos] <- value[ord$newRightPos] mg@edge_sets[[e]]@weights <- newAttr } else { attrBit <- mg@userAttrPos@edgePos[[e]][[attr]] if(nrow(req_i)) { ord <- .Call(graph_bitarray_getEdgeAttrOrder, attrBit, as.integer(req_i[,"from"]), as.integer(req_i[,"to"])) mg@userAttrPos@edgePos[[e]][[attr]] <- setBitCell(attrBit, req_i[,"from"], req_i[,"to"], rep(1L, nrow(req_i))) nt <- attr(mg@userAttrPos@edgePos[[e]][[attr]], "nbitset") } else { nt <- attr(attrBit, "nbitset") ord <- list(newLeftPos = integer(0), newRightPos = integer(0), origLeftPos = seq_len(nt), origRightPos = seq_len(nt)) } newAttr <- vector(nt, mode = mode(value)) newAttr[ord$origLeftPos] <- mg@edge_sets[[e]]@edge_attrs[[attr]][ord$origRightPos] newAttr[ord$newLeftPos] <- value[ord$newRightPos] mg@edge_sets[[e]]@edge_attrs[[attr]] <- newAttr } mg } .retMGAttrVec <- function(g, e, attr) { if(attr !="weight") { k1 <- g@edge_sets[[e]]@bit_vector k2<- g@userAttrPos@edgePos[[e]][[attr]] tmp <- attributes(k1) res <- k1& (!k2) attributes(res) <- tmp ns <- .Call(graph_bitarray_sum, res) attr(res, "nbitset") <- ns ft <- data.frame(.Call(graph_bitarray_rowColPos,res), stringsAsFactors = TRUE) dflt <- g@edge_defaults[[e]][[attr]] attrBit <- g@userAttrPos@edgePos[[e]][[attr]] ft <- ft[with(ft, order(to, from)),] if(nrow(ft)) { ord <- .Call(graph_bitarray_getEdgeAttrOrder, attrBit, as.integer(ft[,"from"]), as.integer(ft[,"to"])) attrBit <- setBitCell(attrBit, ft[,"from"], ft[,"to"], rep(1L, nrow(ft))) nt <- attr(attrBit, "nbitset") } else { nt <- attr(attrBit, "nbitset") ord <- list(newLeftPos = integer(0), newRightPos = integer(0), origLeftPos = seq_len(nt), origRightPos = seq_len(nt)) } newAttr <- vector(nt, mode = mode(dflt)) if(!is.null(g@edge_sets[[e]]@edge_attrs[[attr]])) { newAttr[ord$origLeftPos] <- g@edge_sets[[e]]@edge_attrs[[attr]][ord$origRightPos] newAttr[ord$newLeftPos] <- if(mode(dflt)=="list") { rep(list(dflt), length(ord$newLeftPos)) } else dflt }else{ newAttr[seq_len(nt)] <- if(mode(dflt)=="list") { rep(list(dflt), nt) } else dflt } }else{ newAttr <- g@edge_sets[[e]]@weights } newAttr } .mgGetAttrs <- function(self, edge, from, attr) { nodeNames <- self@nodes indx <- which(nodeNames %in% from) numNodes <- length(nodeNames) bv <- self@edge_sets[[edge]]@bit_vector .verifyMGAttrs(self, edge, attr) val <- .retMGAttrVec(self, edge, attr) ft <- .Call(graph_bitarray_rowColPos, bv) if(!isDirected(self@edge_sets[[edge]])) { df <- cbind(from=ft[,"to"], to = ft[,"from"]) ft <- rbind(ft,df) val <- c(val,val) } tmp <- seq_len(length(val)) ft <- data.frame(ft, tmp, stringsAsFactors = FALSE ) ft <- ft[ ft[,"from"] %in% indx,] if(nrow(ft) == 0) stop("edges specified in \"from\" not found in edgeSet ", sQuote(edge)) nodeLbl <- paste( nodeNames[ft[,"from"]], nodeNames[ft[, "to"]], sep ="|") val <- val[ft[,"tmp"]][seq_along(nodeLbl)] names(val) <- nodeLbl as.list(val) } setMethod("nodeDataDefaults", signature(self="MultiGraph", attr="missing"), function(self, attr){ attrDefaults(self@nodeData) }) setMethod("nodeDataDefaults", signature(self="MultiGraph", attr="character"), function(self, attr){ attrDefaults(self@nodeData, attr) }) setReplaceMethod("nodeDataDefaults", signature(self="MultiGraph", attr="missing", value="list"), function(self, attr, value) { attrDefaults(self@nodeData) <- value nmsNds <- names(self@nodeData@defaults) nmsAttr <- names(self@userAttrPos@nodePos) ndsLbls <- nmsNds[ !(nmsNds %in% nmsAttr)] if(length(ndsLbls)) { ndsLen <- length(nodes(self)) bt <- makebits(ndsLen) } for(i in ndsLbls) { self@userAttrPos@nodePos[[i]] <- bt } self }) setReplaceMethod("nodeDataDefaults", signature(self="MultiGraph", attr="character", value="ANY"), function(self, attr, value) { attrDefaults(self@nodeData, attr) <- value ndsLen <- length(nodes(self)) if(! (attr %in% names(self@userAttrPos@nodePos))){ bt <- makebits(ndsLen) self@userAttrPos@nodePos[[attr]] <- bt } self }) setMethod("edgeSets", signature("MultiGraph"), function(object, ...) { names(object@edge_sets) }) setMethod("edges", signature("MultiGraph"), function(object, which, edgeSet) { if (missing(edgeSet)) edgeSet <- edgeSets(object) if (!all(edgeSet %in% edgeSets(object))) stop("edgeSet specified not found in MultiGraph") if (!missing(which)) { if (!is.character(which)) stop("'which' must be missing or a character vector") if (!all(which %in% nodes(object))) stop("'which' nodes not all in MultiGraph") } eg <- extractGraphBAM(object, edgeSet) if (missing(which)) { if(length(eg) == 1) edges(eg[[edgeSet]]) else lapply(eg, edges) } else { if (length(eg) == 1) edges(eg[[edgeSet]], which) else lapply(eg, edges, which) } }) setMethod("edgeNames", signature("MultiGraph"), function(object, edgeSet) { if(missing(edgeSet)) edgeSet <- edgeSets(object) if (!all(edgeSet %in% edgeSets(object))) stop("edgeSet specified not found in MultiGraph") eg <- extractGraphBAM(object, edgeSet) if(length(eg) == 1) edgeNames(eg[[edgeSet]]) else lapply(eg, edgeNames) }) graph/R/write.tlp.R0000644000175000017500000000160614136046755013777 0ustar nileshnilesh## Copyright Laurent Gautier, 2003 write.tlp <- function(graph, filename) { m <- edgeMatrix(graph) n <- numNodes(graph) con <- file(filename, open="w") ## nodes declaration writeLines("(nodes ", con, sep="") writeLines(as.character(seq(1, n, length=n)), con, sep=" ") writeLines(")\n", con, sep="") ## edges declaration for (i in seq(1, ncol(m), length=ncol(m))) { writeLines("(edge ", con, sep="") writeLines(as.character(c(i, m[1, i], m[2, i])), con, sep=" ") writeLines(")\n", con, sep="") } rm(m) ## nodes label declaration allnodes <- nodes(graph) writeLines("(property 0 string \"viewLabel\"\n", con, sep="") writeLines("(default \"\" \"\" )\n", con, sep="") for (i in seq(along=allnodes)) { writeLines(c("(node ", as.character(i), " \"", allnodes[i], "\")\n"), con, sep="") } writeLines(")\n", con, sep="") close(con) } graph/R/zzz.R0000644000175000017500000000121614136046755012701 0ustar nileshnilesh## unexported environment for persistent stuff like par settings ## specific to the graph package .GraphEnv <- new.env(parent = emptyenv()) .GraphEnv$par <- list() graph.par(.default.graph.pars()) .onUnload <- function( libpath ) { library.dynam.unload("BioC_graph", libpath ) } ## utilities qrequire <- function(package, quietly=TRUE, character.only=TRUE) { suppressWarnings({ require(package, quietly=quietly, character.only=character.only) }) || stop("package required but not installed: ", sQuote(package), call.=FALSE) } pasteq <- function(..., collapse=", ") paste(sQuote(...), collapse=collapse) graph/R/nodes-methods.R0000644000175000017500000000607514136046755014625 0ustar nileshnilesh### helpers .node_rename_check <- function(g, new_nodes) { checkValidNodeName(new_nodes) if (length(new_nodes) != numNodes(g)) stop("need as many names as there are nodes", call.=FALSE) if (any(duplicated(new_nodes))) stop("node names must be unique", call.=FALSE) } .rename_node_attributes <- function(g, new_nodes) { ## FIXME: should be done in place? ## FIXME: we are doing the verification twice :-( old <- nodes(g) idx <- match(names(g@nodeData), old, 0) names(g@nodeData) <- new_nodes[idx] g } .get_edgeData_indicies <- function(g) { ee <- .getAllEdges(g) if (length(ee$from) && length(ee$to)) { kk <- .makeEdgeKeys(ee$from, ee$to) match(names(g@edgeData), kk) } else { integer(0) } } .rename_edge_attributes <- function(g, whEdges) { ee <- .getAllEdges(g) if (length(ee$from) && length(ee$to)) { kk <- .makeEdgeKeys(ee$from, ee$to) names(g@edgeData) <- kk[whEdges] } g } ### graph ## A template method for node<- on graph objects ## ## Subclasses should define a renameNodes method only. ## This way, validation of node names and handling ## of node and edge attributes can be shared. ## setReplaceMethod("nodes", c("graph", "character"), function(object, value) { .node_rename_check(object, value) whEdges <- .get_edgeData_indicies(object) object <- .rename_node_attributes(object, value) ## the template method for different ## graph representations object <- renameNodes(object, value) ## if (length(whEdges)) .rename_edge_attributes(object, whEdges) else object }) ### graphNEL setMethod("nodes", "graphNEL", function(object) object@nodes) setMethod("renameNodes", "graphNEL", function(g, value) { g@nodes <- value names(g@edgeL) <- value g }) ### graphAM setMethod("nodes", signature("graphAM"), function(object) { if (!is.null(nn <- colnames(object@adjMat))) nn else # empty graph character(0) }) setMethod("renameNodes", "graphAM", function(g, value) { colnames(g@adjMat) <- value g }) ### graphBAM setMethod("nodes", signature("graphBAM"), function(object) { object@nodes }) setMethod("renameNodes", "graphBAM", function(g, value) { colnames(g@nodes) <- value g }) ### clusterGraph setMethod("nodes", "clusterGraph", function(object) as.character(unlist(object@clusters))) setMethod("renameNodes", "clusterGraph", function(g, value) { clens = sapply(g@clusters, length) nc = length(clens) ni = rep(seq_len(nc), clens) newc = split(value, ni) names(newc) = names(g@clusters) g@clusters = newc g }) ### distGraph setMethod("nodes", "distGraph", function(object) attr(object@Dist, "Labels" )) graph/R/methods-graphAM.R0000644000175000017500000002753114136046755015034 0ustar nileshnilesh## adjacency matrix representation of a graph isValidAdjMat <- function(adjMat, mode="undirected") { ## Determine if adjacency matrix adjMat is valid Element adjMat[i, j] == 1 ## if the graph contains an edge FROM node i TO node j. If mode is ## "undirected", then adjMat should be symmetrix. if (length(adjMat) == 0L) return(character(0L)) if (! nrow(adjMat) == ncol(adjMat)) stop("adjacency matrix must be square") if (mode == "undirected") if (any(adjMat != t(adjMat))) ## XXX: this could be slow stop("adjacency matrix must be symmetric for undirected graphs") if (any(adjMat < 0)) stop("adjacency matrix must not have negative values") if (is.null(dimnames(adjMat))) { nNames <- NULL } else { ## take first non-null dimname nonNullIndices <- which(sapply(dimnames(adjMat), function(x) !is.null(x))) nNames <- dimnames(adjMat)[[nonNullIndices[1]]] if (any(duplicated(nNames))) stop("node names must be distinct") checkValidNodeName(nNames) if (length(nonNullIndices) == 2) { ## verify rownames match colnames if (any(rownames(adjMat) != colnames(adjMat))) stop("row and column names must match") } } return(nNames) } isValidNodeList <- function(nList, nNames) { if (!is.list(nList) || is.null(names(nList))) stop("nodes must be specified as a named list") if (!setequal(names(nList), nNames)) stop("names of node list must match graph node names") return(TRUE) } initEdgeSet <- function(self, values) { ## Put matrix elements into @edgeData using attr name from 'values'. if (!is.list(values) || length(values) != 1 || is.null(names(values))) stop("'values' must be a named list with one element") self@edgeData <- new("attrData", defaults=values) valName <- names(values)[1] eSpec <- .getAllEdges(self) from <- eSpec$from to <- eSpec$to if (length(from) > 0L && length(to) > 0L) { v <- t(self@adjMat) v <- v[v != 0] ## this unrolls the matrix in the right way edgeData(self, from=from, to=to, attr=valName) <- v ## FIXME: consider storing matrix as logical } self } setMethod("initialize", signature("graphAM"), function(.Object, adjMat, edgemode="undirected", values) { nNames <- isValidAdjMat(adjMat, edgemode) if (is.null(nNames)) nNames <- paste0("n", seq_len(ncol(adjMat))) .Object@graphData$edgemode <- edgemode .Object@nodeData <- new("attrData") colnames(adjMat) <- nNames rownames(adjMat) <- NULL .Object@adjMat <- adjMat if (!missing(values)) .Object <- initEdgeSet(.Object, values) else .Object@edgeData <- new("attrData") ## Matrix values have been stored in @edgeData, ## so now we normalize to 0/1 adjMat <- .Object@adjMat adjMat[adjMat != 0L] <- 1L .Object@adjMat <- adjMat .Object }) getEdgeList <- function(adjMat, nodeNames) { numNodes <- length(nodeNames) eList <- vector(mode="list", length=numNodes) for (i in seq(length=numNodes)) { aRow <- adjMat[i, ] result <- names(base::which(aRow != 0)) if (is.null(result)) result <- character(0) eList[[i]] <- result } names(eList) <- nodeNames eList } setMethod("edges", signature("graphAM"), function(object, which) { adjMat <- object@adjMat if (length(adjMat) == 0L) return(list()) nodes <- nodes(object) if (!missing(which)) { if (!is.character(which)) stop("'which' must be missing or a character vector") idx <- base::which(colnames(adjMat) %in% which) adjMat <- adjMat[idx, ] nodes <- nodes[idx] } getEdgeList(adjMat, nodes) }) setMethod("numNodes", signature("graphAM"), function(object) length(nodes(object))) setMethod("numEdges", signature(object="graphAM"), function(object) { nE <- sum(object@adjMat != 0) if (!isDirected(object)) { selfLoops <- sum(diag(object@adjMat) != 0) nE <- selfLoops + (nE - selfLoops)/2 } nE }) setMethod("isAdjacent", signature(object="graphAM", from="character", to="character"), function(object, from, to) { eSpec <- .normalizeEdges(from, to) from <- eSpec$from to <- eSpec$to fromIdx <- match(from, nodes(object), nomatch=0) toIdx <- match(to, nodes(object), nomatch=0) if (any(fromIdx == 0)) stop("'from' unknown node(s): ", pasteq(from[fromIdx == 0])) if (any(toIdx == 0)) stop("'to' unknown nodes: ", pasteq(to[toIdx == 0])) result <- logical(length(fromIdx)) for (i in seq_along(fromIdx)) result[i] <- object@adjMat[fromIdx[i], toIdx[i]] != 0 result }) extendAdjMat <- function(adjMat, nodes) { nms <- c(colnames(adjMat), nodes) curCols <- ncol(adjMat) newCols <- matrix(0, nrow=curCols, ncol=length(nodes)) adjMat <- cbind(adjMat, newCols) newRows <- matrix(0, nrow=length(nodes), ncol=ncol(adjMat)) adjMat <- rbind(adjMat, newRows) colnames(adjMat) <- nms adjMat } getIndices <- function(nodes, from, to) { ## Return indices into the adjMat for nodes from and to. i <- match(from, nodes, nomatch=0) if (any(bad <- (i == 0))) stop("'from' unknown node(s): ", sQuote(from[bad])) j <- match(to, nodes, nomatch=0) if (any(bad <- (j == 0))) stop("'to' unknown node(s): ", sQuote(to[bad])) list(from=i, to=j) } setMethod("addNode", signature(node="character", object="graphAM", edges="missing"), function(node, object) { already <- node %in% nodes(object) if(any(already)) stop("node(s) already exist: ", pasteq(node[already])) checkValidNodeName(node) object@adjMat <- extendAdjMat(object@adjMat, node) object }) setMethod("addEdge", signature(from="character", to="character", graph="graphAM", weights="missing"), function(from, to, graph) { if (any(bad <- isAdjacent(graph, from, to))) stop("edge(s) already exist: ", pasteq(paste(from[bad], to[bad], sep="|"))) idx <- getIndices(nodes(graph), from, to) idx <- cbind(idx$from, idx$to) graph@adjMat[idx] <- 1L if (! isDirected(graph)) graph@adjMat[idx[ , c(2L, 1L)]] <- 1L graph }) setMethod("clearNode", signature(node="character", object="graphAM"), function(node, object) { idx <- getNodeIndex(nodes(object), node) zeroVect <- rep(0, ncol(object@adjMat)) ## clear edges from node to other object@adjMat[idx, ] <- zeroVect ## clear edges from other to node object@adjMat[, idx] <- zeroVect ## TODO: clear edge attributes object }) ## TODO: implement a clearEdgeAttributes method setMethod("removeNode", signature(node="character", object="graphAM"), function(node, object) { idx <- getNodeIndex(nodes(object), node) object@adjMat <- object@adjMat[-idx, -idx] ## TODO: clear edge attributes object }) getNodeIndex <- function(nodeNames, node) { idx <- match(node, nodeNames, nomatch=NA) if (any(is.na(idx))) stop("unknown node(s): ", pasteq(node[is.na(idx)])) idx } coordToIndex <- function(x, y, nrow) (y * nrow) - (nrow - x) setMethod("removeEdge", signature(from="character", to="character", graph="graphAM"), function(from, to, graph) { fromIdx <- getNodeIndex(nodes(graph), from) toIdx <- getNodeIndex(nodes(graph), to) rowCnt <- nrow(graph@adjMat) graph@adjMat[coordToIndex(fromIdx, toIdx, rowCnt)] <- 0 if (!isDirected(graph)) graph@adjMat[coordToIndex(toIdx, fromIdx, rowCnt)] <- 0 graph }) ## This signature looks strange, but to get in edges for all nodes ## it makes sense to be able to write inEdges(g) setMethod("inEdges", signature(node="graphAM", object="missing"), function(node, object) { allNodes <- nodes(node) return(inEdges(allNodes, node)) }) ## But we still want inEdges(object=g) to work setMethod("inEdges", signature(node="missing", object="graphAM"), function(node, object) { allNodes <- nodes(object) return(inEdges(allNodes, object)) }) setMethod("inEdges", signature(node="character", object="graphAM"), function(node, object) { allNodes <- nodes(object) unknownNodes <- !(node %in% allNodes) if (any(unknownNodes)) stop("unknown nodes: ", pasteq(node[unknownNodes])) ## cols of adjMat tells us in edges adjMat <- object@adjMat ans <- list() for (n in node) { ans[[n]] <- allNodes[as.logical(adjMat[, n])] } ans }) setAs(from="graphAM", to="matrix", function(from) { am <- from@adjMat if (length(am) == 0L) return(am) if ("weight" %in% names(edgeDataDefaults(from))) { tm <- t(am) tm[tm != 0] <- unlist(edgeData(from, attr="weight")) m <- t(tm) } else { m <- am } rownames(m) <- colnames(m) m }) ## ^^ the reverse is in ./mat2graph.R setAs(from="graphAM", to="graphNEL", function(from) { gnel <- graphNEL(nodes=nodes(from), edgeL=edges(from), edgemode=edgemode(from)) ## copy edge and node attributes: gnel@edgeData <- from@edgeData gnel@nodeData <- from@nodeData gnel }) ## This is also used in mat2graph.R : NEL2mat <- function(g) { theNodes <- nodes(g) numNodes <- length(theNodes) mat <- matrix(0:0, nrow=numNodes, ncol=numNodes) rownames(mat) <- colnames(mat) <- theNodes theEdges <- edges(g) wts <- edgeWeights(g) use.wts <- any(unlist(wts) != 1) for (n in theNodes) { e <- theEdges[[n]] if (length(e)) mat[n, e] <- if(use.wts) wts[[n]] else 1L } mat } setAs(from="graphNEL", to="graphAM", function(from) { theNodes <- nodes(from) numNodes <- length(theNodes) mat <- matrix(0, nrow=numNodes, ncol=numNodes, dimnames=list(theNodes, theNodes)) theEdges <- edges(from) for (n in theNodes) { e <- theEdges[[n]] if (length(e)) mat[n, e] <- 1 } ## XXX: it would be safer to pass mat here, but since we cannot ## yet pass in the edgeData and nodeData, we benefit greatly ## by avoiding the copying of large matrices. gam <- graphAM(matrix(0), edgemode=edgemode(from)) ## one of the things that initialize will do is remove row ## names, so that only one copy of node names are stored rownames(mat) <- NULL ## copy edge and node attributes gam@edgeData <- from@edgeData gam@nodeData <- from@nodeData gam@adjMat <- mat gam }) graph/R/methods-graph.R0000644000175000017500000011076214136046755014615 0ustar nileshnilesh## String used as the separator to name edges in a graph. EDGE_KEY_SEP <- "|" EDGEMODE_DEPR_MSG <- "The edgemode slot is deprecated.\nUse 'updateGraph' to update this graph object." EDGEMODE_DEFUNCT_MSG <- "The edgemode slot no longer exists.\nUse 'updateGraph' to update this graph object." checkValidNodeName <- function(node) { if (!is.character(node)) stop("node names must be character, got: ", sQuote(class(node))) ## Node names must have nchar(n) > 0, not be NA, ## and not contain the EDGE_KEY_SEP character. if (any(nchar(node) == 0)) stop("invalid node names: empty string not allowed") if (any(is.na(node))) stop("invalid node names: missing value NA not allowed") bad <- grep(EDGE_KEY_SEP, node, fixed=TRUE) if (length(bad)) stop("node name(s) contain edge separator ", sQuote(EDGE_KEY_SEP), ": ", pasteq(node[bad])) TRUE } setMethod("isDirected", "graph", function(object){ edgemode(object) == "directed" }) ## Look through all serialized object within a folder, check if they are of ## class graph and update if necessary. This is not recursive, so lists of ## graphs or graphs within slots of objects will not be updated. updateFolder <- function(path="."){ files <- dir(path, pattern="\\.rda$") for(f in files){ env <- new.env() load(f, envir=env) objects <- ls(env) needSave <- FALSE for(i in objects){ if(is(get(i, env), "graph") && !isUpToDate(get(i, env))){ assign(i, updateGraph(get(i, env)), envir=env) cat("Updated graph object", i, "\n") needSave <- TRUE } } if(needSave) save(list=objects, file=file.path(path,f), envir=env) } } ## Get the "real" slots of an object (slotNames gets the slots from ## the object definition) getObjectSlots <- function(object) { if(!is.object(object) || isVirtualClass(class(object))) return(NULL) value <- attributes(object) value$class <- NULL if(is(object, "vector")) { .Data <- as.vector(object) attr(.Data, "class") <- NULL attrNames <- c('comment', 'dim', 'dimnames', 'names', 'row.names', 'tsp') for (nm in names(value)[names(value) %in% attrNames]) attr(.Data, nm) <- value[[nm]] value <- value[!names(value) %in% attrNames] value$.Data <- .Data } value } ## (FH 11/7/07) If the graph object is not up to data give a ## deprecated warning and try to find something useful, ## else use the edgemode item of the graphData list setMethod("edgemode", "graph", function(object) { if(!isUpToDate(object)){ ## first check in graphData then in edgemode slot if(!"graphData" %in% names(getObjectSlots(object))){ .Defunct(msg=EDGEMODE_DEFUNCT_MSG) }else{ em <- object@graphData$edgemode if (is.null(em) && hasEdgemode(object)) em <- object@edgemode if(is.null(em)) stop("'graph' object is corrupted") } }else em <- object@graphData$edgemode return(em) }) ## (FH 11/7/07) Changed this to update the object in case it is outdated ## (edgemode now lives as a list item in graphData) setReplaceMethod("edgemode", c("graph", "character"), function(object, value) { if(length(value) != 1L) stop("'edgemode' must be length 1") if(!(value %in% c("directed", "undirected")) ) stop("'edgemode' must be 'directed' or 'undirected', was ", sQuote(value)) if(hasEdgemode(object)){ warning("'edgemode' slot is deprecated; ", "this graph object has been updated to ", "a new version", call.=FALSE) object <- updateGraph(object) } object@graphData$edgemode <- value edgeRenderInfo(object) <- list(arrowhead=NULL, arrowtail=NULL) object }) ## Check if graph object is up to date isUpToDate <- function(object, error=FALSE) { if(!is(object, "graph")) stop("'object' must inherit from class 'graph'") availSlots <- getObjectSlots(object) availSlotNames <- names(availSlots) definedSlotNames <- slotNames(object) valid <- setequal(availSlotNames, definedSlotNames) && length(object@graphData$edgemode) if(error && !valid) .Defunct(msg=EDGEMODE_DEFUNCT_MSG) return(valid) } hasEdgemode <- function(object) { if(!is(object, "graph")) stop("'object' must inherit from class 'graph'") sn <- names(getObjectSlots(object)) return("edgemode" %in% sn) } ## Update an old graph instance setMethod("updateGraph", "graph", function(object) { availSlots <- getObjectSlots(object) availSlotNames <- names(availSlots) definedSlotNames <- slotNames(object) if(isUpToDate(object)){ message("This graph object seems to be up to date") newObject <- object }else{ commonSlots <- intersect(definedSlotNames, availSlotNames) missingSlots <- setdiff(definedSlotNames, availSlotNames) if("graphData" %in% missingSlots && !"edgemode" %in% availSlotNames) stop("'object' is corrupted, don't know how to update.") newObject <- new(class(object)) for(s in commonSlots) slot(newObject, s) <- availSlots[[s]] edgemode(newObject) <- suppressWarnings(edgemode(object)) } return(newObject) }) setMethod("numEdges", signature(object="graph"), function(object) { gEdges <- edges(object) if (length(gEdges) == 0) return(0) numEdges <- length(unlist(gEdges, use.names=FALSE)) if (!isDirected(object)) { numSelfLoops <- sum(mapply(function(e, n) sum(n == e), gEdges, names(gEdges))) numEdges <- numSelfLoops + (numEdges - numSelfLoops) / 2 } numEdges }) ## a node-edge-list graph ##the edgeL is a list, with edges, weights etc setMethod("isAdjacent",signature(object="graph", from="character", to="character"), function(object, from, to) { eSpec <- .normalizeEdges(from, to) from <- eSpec$from to <- eSpec$to fromIdx <- match(from, nodes(object), nomatch=0) toIdx <- match(to, nodes(object), nomatch=0) if (any(fromIdx == 0)) stop("unknown nodes in 'from': ", pasteq(from[fromIdx == 0])) if (any(toIdx == 0)) stop("unknown nodes in 'to': ", pasteq(to[toIdx == 0])) fromEdges <- edges(object)[from] .Call(graph_is_adjacent, fromEdges, to) }) setMethod("degree", "graph", function(object, Nodes) { nl <- edges(object) if (missing(Nodes)) Nodes <- nodes(object) nls <- nl[Nodes] deg <- listLen(nls) names(deg) <- Nodes if (!isDirected(object)) return(deg) else { b1 <- unlist(nl) b2 <- table(b1) nonZeroNodes <- Nodes[Nodes %in% names(b2)] inDegree <- structure(integer(length(Nodes)), names=Nodes) inDegree[nonZeroNodes] <- as.integer(b2[nonZeroNodes]) return(list(inDegree=inDegree, outDegree=deg)) } }) setMethod("leaves", "graph", function(object, degree.dir) { deg <- degree(object) leaf_degree <- 1L if (isDirected(object)) { if (missing(degree.dir)) stop("'degree.dir' must be specified for a directed graph") degree.dir <- switch(match.arg(degree.dir, c("in", "out")), "in"="inDegree", "out"="outDegree") deg <- deg[[degree.dir]] leaf_degree <- 0L } wh <- deg == leaf_degree names(deg)[wh] }) ## setMethod("acc", "graph", function(object, index) { ## visit <- function(ind) { ## marked[ind] <<- TRUE ## alist <- adj(object, ind)[[1]] ## for( EDGE in alist) { ## if( !marked[EDGE] ) { ## visit(EDGE) ## rval <<- c(EDGE, rval) ## } ## } ## } ## marked <- rep(FALSE, numNodes(object)) ## rval <- vector(length=0) ## names(marked) <- nodes(object) ## visit(index) ## return(rval) ## }, where = where) ##an iterative method ! yuck setMethod("acc", c("graph", "character"), function(object, index) { nN <- numNodes(object) nNames<- nodes(object) nIndex <- length(index) whN <- match(index, nNames) if( any(is.na(whN)) ) stop("unmatched node provided") rval <- vector("list", length=nIndex) names(rval) <- nNames[whN] for( i in seq_len(nIndex)) { marked<-rep(0, nN) distv <- rep(0, nN) names(distv) <- nNames distx <- 1 names(marked) <- nNames nmkd <- 0 marked[index[i]] <- 1 done <- FALSE while( !done ) { minds <- nNames[marked==1] for( node in minds) { avec <- adj(object, node)[[1]] avec <- avec[marked[avec]==0] #don't mark any already marked marked[avec] <- 1 distv[avec] <- distx } marked[minds] <- 2 distx <- distx+1 newmk <- sum(marked==1) if( newmk == 0 ) done <- TRUE } marked[index[i]] <- 0 ##not the node itself rval[[i]] <- distv[marked==2] } return(rval) }) setMethod("edgeWeights", signature(object="graph", index="character"), function(object, index, attr, default, type.checker) { ## Check extra args if (!is.character(attr) || length(attr) != 1) stop("'attr' must be character(1)") if (!is.null(type.checker) && !is.function(type.checker)) stop("'type.checker' be a function or NULL") if (! attr %in% names(edgeDataDefaults(object))) { ## No existing 'weight' edge attr, uses default edgeDataDefaults(object, attr) <- default } ew <- edgeData(object, from=index, attr=attr) if (!length(ew)) return(lapply(edges(object), function(x) vector(mode=mode(default), length=0))[index]) gEdges <- edges(object)[index] edgeCounts <- sapply(gEdges, length) nn <- rep(index, edgeCounts) names(ew) <- unlist(gEdges, use.names=FALSE) ew <- unlist(ew) if (!is.null(type.checker) && !isTRUE(type.checker(ew))) stop("edge weight type.checker(ew) not TRUE\n", "typeof(ew): ", typeof(ew)) ## for (el in ew) { ## ## XXX: if el is an S4 instance, it will match "list" ## if (!isTRUE(type.checker(el))) ## stop("invalid type of edge weight.\n", ## "type.checker(el) not TRUE\n", ## "typeof(el): ", typeof(el)) ## } ## if (!is.null(type.checker)) { ## dMode <- storage.mode(default) ## tryCatch(storage.mode(ew) <- dMode, ## warning=function(w) { ## wMsg <- conditionMessage(w) ## msg <- paste("unable to type.checker edge weight to", ## dMode, "\n", wMsg) ## if (grep("NA", msg)) ## stop(msg) ## else ## warning(wMsg) ## }) ans = split(unlist(ew), nn) ans <- c(ans, lapply(gEdges[edgeCounts == 0], as.numeric)) ans[index] ## split does sorting, we want orig order }) setMethod("edgeWeights", signature(object="graph", index="numeric"), function(object, index, attr, default, type.checker) { index <- nodes(object)[index] edgeWeights(object, index, attr=attr, default=default, type.checker=type.checker) }) setMethod("edgeWeights", signature(object="graph", index="missing"), function(object, index, attr, default, type.checker) { index <- nodes(object) edgeWeights(object, index, attr=attr, default=default, type.checker=type.checker) }) setMethod("DFS", c("graph", "character", "ANY"), function(object, node, checkConn=TRUE) { nNames <- nodes(object) marked <- rep(NA, length(nNames)) names(marked) <- nNames m1 <- match(node, nNames) if( is.na(m1) ) stop("node not in graph: ", sQuote(node)) ##this could be expensive if (checkConn) { c1 <- connComp(object) if(length(c1) != 1) stop("graph is not connected") } marked[m1] <- 0 ##repeat until all are marked - marked has no NA's counter <- 1 while( any(is.na(marked)) ) { fE <- boundary(nNames[!is.na(marked)], object) fE <- fE[sapply(fE, length) > 0] wh <- marked[names(fE)] v1 <- sort(wh) newN <- fE[[names(v1)[v1==max(v1)]]] marked[newN[1]] <- counter counter <- counter+1 } return(marked) }) ### yet another implementation of "intersection", in C setMethod("intersection2", c("graph", "graph"), function(x,y) { if (edgemode(x) != edgemode(y) ) stop("both graphs must have the same edgemode") if (edgemode(x) == "undirected") edgeM <- 0 else edgeM <- 1 .Call(graph_intersection, nodes(x), nodes(y), edges(x), edges(y), edgeM) }) setMethod("intersection", c("graph", "graph"), function(x,y) { if( edgemode(x) != edgemode(y) ) stop("both graphs must have the same edgemode") xN <- nodes(x) yN <- nodes(y) bN <- intersect(xN, yN) if( length(bN) == 0 ) return(graphNEL(nodes=character(0), edgeL=vector("list", 0), edgemode=edgemode(x))) ##lb <- length(bN) ##if(lb != length(xN) || lb != length(yN)) ## stop("graphs must have the same node set") xE <- edges(x, bN) xE = lapply(xE, function(x) { x[x %in% bN]}) yE <- edges(y, bN) yE = lapply(yE, function(x) { x[x %in% bN]}) rval <- vector("list", length=length(xE)) for(i in seq_along(xE) ) { ans <- intersect(xE[[i]], yE[[i]]) rval[[i]] <- list(edges=match(ans, bN), weights=rep(1, length(ans))) } names(rval) <- bN graphNEL(nodes=bN, edgeL=rval, edgemode=edgemode(x)) }) setMethod("join", c("graph", "graph"), function(x, y) { ex <- edgemode(x); ey <- edgemode(y) if(ex == ey) outmode <- ex else stop("cannot handle different edgemodes") nX <- nodes(x) numXnodes <- length(nX) nY <- nodes(y) ## Combine the two sets of nodes, removing any duplications newNodes <- unique(c(nX, nY)) eLX <- edgeL(x) eLY <- edgeL(y) newEdgeL <- eLX ## Can't just cat the edgeL's together like this ## as the node #s have all changed. if (length(eLY) > 0) { eLYnames <- names(eLY) for (i in seq_along(eLY)) { newEntry <- eLY[i] ## !! first need to adjust the targets on the edges newEdges <- newEntry[[1]]$edges if (length(newEdges) > 0) { for (j in seq_along(newEdges)) { curTo <- nY[newEdges[j]] newTo <- match(curTo,newNodes) if (is.na(newTo)) stop("error reassigning duplicated nodes") newEdges[j] <- newTo } } newEntry[[1]]$edges <- newEdges ## now need to attach it to the list. If this ## is a duplicated node, combine it with the ## original, otherwise add it ot the list if (length(newEdgeL) == 0) newEdgeL <- newEntry else if (eLYnames[i] %in% nX) { entry <- which(names(newEdgeL) == eLYnames[i]) if (length(entry) > 1) stop("duplicated node names in original graph") curEntry <- newEdgeL[[entry]] curEntry$edges <- c(curEntry$edges, newEntry[[1]]$edges) curEntry$weights <- c(curEntry$weights, newEntry[[1]]$weights) ##should be user adjustable - ##for now just remove extras dups = duplicated(curEntry$edges) if(any(dups) ) { curEntry$edges = curEntry$edges[!dups] curEntry$weights = curEntry$weights[!dups] } if (!is.null(curEntry)) newEdgeL[[entry]] <- curEntry } else newEdgeL <- c(newEdgeL,newEntry) } } ## Some graphs have edgeL's that are missing the original ## node from the edgeL. When we collated the edgeL above, ## those nodes will be missing - so need to make sure that ## all nodes are present, as the graphNEL() call below ## will check to make sure that length(nodes) == length(edgeL) for (missNode in newNodes[! newNodes %in% names(newEdgeL)]) { newEdgeL[[length(newEdgeL) + 1]] <- list(edges=numeric(), weights=numeric()) names(newEdgeL)[length(newEdgeL)] <- missNode } graphNEL(nodes=newNodes, edgeL=newEdgeL, edgemode=ex) }) setMethod("union", c("graph", "graph"), function(x, y, ...) { ex <- edgemode(x); ey <- edgemode(y); if( ex == ey ) outmode <- ex else stop("cannot handle different edgemodes") xN <- sort(nodes(x)) yN <- sort(nodes(y)) if( any(xN != yN) ) stop("graphs must have the same nodes") xE <- edges(x) yE <- edges(y) rval <- vector("list", length=length(xE)) names(rval) <- xN for(i in names(xE) ) { ans <- unique(c(xE[[i]], yE[[i]])) rval[[i]] <- if( length(ans) > 0 ) list(edges = match(ans, xN), weights= rep(1, length(ans))) else list(edges=numeric(0), weights=numeric(0)) } names(rval) <- xN graphNEL(nodes=xN, edgeL=rval, edgemode=outmode) }) setMethod("complement", c("graph"), function(x) { if( edgemode(x) != "undirected" ) stop("'edgemode' not supported: ", sQuote(edgemode(x))) xN <- nodes(x) xE <- edges(x) rval <- vector("list", length=length(xE)) names(rval) <- xN for( i in xN ) { ans <-xN[ !(xN %in% c(i, xE[[i]])) ] lena <- length(ans) if( lena > 0 ) rval[[i]] <- list(edges=match(ans, xN), weights=rep(1, lena)) else rval[[i]] <- list(edges=numeric(0), weights=numeric(0)) } graphNEL(nodes=xN, edgeL=rval, edgemode=edgemode(x)) }) ##connected components setMethod("connComp", "graph", function(object) { ##if directed we do weak connectivity ##by transforming to the underlying undirected graph if( edgemode(object) == "directed") object = ugraph(object) NL <- nodes(object) marked <- rep(0, length(NL)) names(marked) <- NL done <- FALSE rval <- vector("list", 1) cnode <- 1 index <- 1 nused <- numeric(0) while( !done ) { curracc <- acc(object, NL[cnode])[[1]] rval[[index]] <- curracc nused <- c(nused, cnode) index <- index + 1 if( length(curracc) > 0 ) marked[names(curracc)] <- 1 marked[cnode] <- 1 cnode <- match(0, marked) if( is.na(cnode) ) done <- TRUE } nmR <- NL[nused] nc <- length(rval) rL <- vector("list", length=nc) for(i in seq_len(nc)) rL[[i]]<-c(nmR[[i]], names(rval[[i]])) return(rL) }) setMethod("isConnected", "graph", function(object, ...) (length(connComp(object)) == 1)) setMethod("numNodes", "graph", function(object) length(nodes(object))) setMethod("show", signature("graph"), function(object) { isUpToDate(object, error=TRUE) numNodes<- numNodes(object) numEdge<-numEdges(object) cat("A", class(object), "graph with", edgemode(object), "edges\n") cat("Number of Nodes =", numNodes, "\n") cat("Number of Edges =", numEdge, "\n") }) .edgeWeight <- function(from, to, graph) { gN <- nodes(graph) wF <- match(from, gN) if( is.na(wF) ) stop("not a node: ", sQuote(from)) wT <- match(to, gN) if( is.na(wT) ) stop("not a node: ", sQuote(to)) eL <- graph@edgeL[[from]] mt <- match(wT, eL$edges) if(is.na(mt) ) stop("no edge from ", sQuote(from), " to ", sQuote(to)) eL$weights[mt] } ##take a sparse matrix - csr and put it into a graph sparseM2Graph <- function(sM, nodeNames, edgemode=c("directed", "undirected")) { ## FIXME: this needs to become a method qrequire("SparseM") edgemode <- match.arg(edgemode) nN <- dim(sM)[1] if( nN != dim(sM)[2] ) stop("only square matrices can be transformed") if( length(nodeNames) != nN ) stop("wrong number of node names supplied") if( !is.character(nodeNames) ) stop("wrong type of node names supplied") dd <- diff(sM@ia) e1 <- rep(seq_len(nN), dd) eL <- split(sM@ja, e1) eW <- split(sM@ra, e1) edL <- vector("list", length=nN) names(edL) <- seq_len(nN) for(i in as.character(seq_len(nN)) ){ ##need this because otherwise partial matching is done if( i %in% names(eL) ) edL[[i]] <- list(edges=eL[[i]], weights=eW[[i]]) else edL[[i]] <- list(edges=numeric(0)) } names(edL) <- nodeNames graphNEL(nodes=nodeNames, edgeL=edL, edgemode=edgemode) } ##translate a graph to a SparseMatrix: ##ra - the values; these will be 1's for now ##ja - the column indices ##ia the row offsets ( graph2SparseM <- function(g, useweights=FALSE) { ## FIXME: this needs to become a method qrequire("SparseM") if (! is(g, "graphNEL")) stop("coercion only works for graphNEL class") nr = nc = numNodes(g) e1 = g@edgeL e2 = lapply(e1, function(x) x$edges) eL = listLen(e2) if (useweights && ("weight" %in% names(edgeDataDefaults(g)))) ra <- unlist(edgeData(g, attr="weight")) else ra = rep(1, sum(eL)) ja = as.integer(unlist(e2)) ia = as.integer(cumsum(c(1, eL))) new("matrix.csr", ra=ra, ja=ja, ia=ia, dimension=c(nr, nc)) } ##-------------------------- ## edge names ##-------------------------- setMethod("edgeNames", signature="graph", definition=function(object, recipEdges=c("combined", "distinct")) { recipEdges <- match.arg(recipEdges) ## convert names to integers ("standard node labeling") to <- lapply(edges(object), match, nodes(object)) from <- match(names(to), nodes(object)) if(any(is.na(unlist(to)))||any(is.na(from))) stop("edge names do not match node names") ## from-to matrix ft <- matrix(c(rep(from, listLen(to)), to=unlist(to)), ncol=2) if (recipEdges == "combined") { ## revert those edges for which 'from' > 'to' revert <- ft[, 1] > ft[, 2] ft2 <- ft ft2[revert,] <- ft2[revert, c(2, 1)] ft <- ft[!duplicated.array(ft2, MARGIN=1),, drop=FALSE] } return(paste(nodes(object)[ft[, 1]], nodes(object)[ft[, 2]], sep="~")) }, valueClass="character") ##-------------------------- ## clustering coefficient ##-------------------------- setMethod("clusteringCoefficient", signature=signature(object="graph"), definition=function(object, selfLoops=FALSE) { if(edgemode(object)!="undirected") return(NULL) ## Convert names to integers ("standard node labeling") ## This is here for efficiency - the matching code in the for-loop ## below would also work for the characters (names). to <- lapply(edges(object), match, nodes(object)) from <- match(names(to), nodes(object)) if(any(is.na(unlist(to)))||any(is.na(from))) stop("edge names do not match node names") if(!selfLoops) { ufrom <- rep(from, listLen(to)) uto <- unlist(to) if(any(ufrom==uto)) stop("graph must not contain self-loops") totEdges <- function(i) i*(i-1) } else { totEdges <- function(i) i*i } clustCoef <- rep(as.numeric(NA), numNodes(object)) names(clustCoef) <- nodes(object) for (i in which(listLen(to)>0)) { ## to[[i]] are all the nodes reached from i. ## to[ to[[i]] ] are all second-degree neihbours nb <- sapply(to[ to[[i]] ], function(x) sum(!is.na(match(x, to[[i]])))) clustCoef[from[i]] <- sum(nb) / totEdges(length(nb)) } return(clustCoef) }, valueClass="numeric") ## --------------------------------------------------------------------- ## node data access ## --------------------------------------------------------------------- setMethod("nodeDataDefaults", signature(self="graph", attr="missing"), function(self, attr) attrDefaults(self@nodeData)) setMethod("nodeDataDefaults", signature(self="graph", attr="character"), function(self, attr) attrDefaults(self@nodeData, attr)) setReplaceMethod("nodeDataDefaults", signature(self="graph", attr="missing", value="list"), function(self, attr, value) { attrDefaults(self@nodeData) <- value self }) setReplaceMethod("nodeDataDefaults", signature(self="graph", attr="character", value="ANY"), function(self, attr, value) { attrDefaults(self@nodeData, attr) <- value self }) .verifyNodes <- function(n, nodes) { unknownNodes <- n[! n %in% nodes] if (length(unknownNodes) > 0) stop("unknown nodes: ", pasteq(unknownNodes)) TRUE } setMethod("nodeData", signature(self="graph", n="character", attr="character"), function(self, n, attr) { .verifyNodes(n, nodes(self)) attrDataItem(self@nodeData, x=n, attr=attr) }) setReplaceMethod("nodeData", signature(self="graph", n="character", attr="character", value="ANY"), function(self, n, attr, value) { .verifyNodes(n, nodes(self)) attrDataItem(self@nodeData, x=n, attr=attr) <- value self }) setMethod("nodeData", signature(self="graph", n="character", attr="missing"), function(self, n, attr) { .verifyNodes(n, nodes(self)) attrDataItem(self@nodeData, x=n) }) setMethod("nodeData", signature(self="graph", n="missing", attr="character"), function(self, n, attr) { attrDataItem(self@nodeData, x=nodes(self), attr=attr) }) setReplaceMethod("nodeData", signature(self="graph", n="missing", attr="character", value="ANY"), function(self, n, attr, value) { attrDataItem(self@nodeData, x=nodes(self), attr=attr) <- value self }) setMethod("nodeData", signature(self="graph", n="missing", attr="missing"), function(self, n, attr) { attrDataItem(self@nodeData, x=nodes(self)) }) ## --------------------------------------------------------------------- ## --------------------------------------------------------------------- ## edge data access ## --------------------------------------------------------------------- setMethod("edgeDataDefaults", signature(self="graph", attr="missing"), function(self, attr) attrDefaults(self@edgeData)) setMethod("edgeDataDefaults", signature(self="graph", attr="character"), function(self, attr) attrDefaults(self@edgeData, attr)) setReplaceMethod("edgeDataDefaults", signature(self="graph", attr="missing", value="list"), function(self, attr, value) { attrDefaults(self@edgeData) <- value self }) setReplaceMethod("edgeDataDefaults", signature(self="graph", attr="missing", value="list"), function(self, attr, value) { attrDefaults(self@edgeData) <- value self }) setReplaceMethod("edgeDataDefaults", signature(self="graph", attr="character", value="ANY"), function(self, attr, value) { attrDefaults(self@edgeData, attr) <- value self }) .normalizeEdges <- function(from, to) { lenFr <- length(from) lenTo <- length(to) if (lenFr > lenTo) { if (lenTo != 1) stop("'to' must be length 1 or ", lenFr) to <- rep(to, lenFr) } else if (lenFr < lenTo) { if (lenFr != 1) stop("'from' must be length 1 or ", lenTo) from <- rep(from, lenTo) } list(from=from, to=to) } .verifyEdges <- function(graph, from, to) { stopifnot(length(from) == length(to)) if (length(from) == 0L) return(TRUE) # no edges adjList <- isAdjacent(graph, from, to) if (any(!adjList)) { badFr <- from[!adjList] badTo <- to[!adjList] res <- paste(badFr, badTo, sep=EDGE_KEY_SEP, collapse=", ") stop("edges not found: ", sQuote(res)) } TRUE } .makeEdgeKeys <- function(from, to) { stopifnot(length(from) == length(to)) paste(from, to, sep=EDGE_KEY_SEP) } .getEdgeKeys <- function(graph, from, to) { eSpec <- .normalizeEdges(from, to) from <- eSpec$from to <- eSpec$to .verifyEdges(graph, from, to) edgeKeys <- .makeEdgeKeys(from, to) edgeKeys } setMethod("edgeData", signature(self="graph", from="character", to="character", attr="character"), function(self, from, to, attr) { edgeKeys <- .getEdgeKeys(self, from, to) attrDataItem(self@edgeData, x=edgeKeys, attr=attr) }) setMethod("edgeData", signature(self="graph", from="character", to="missing", attr="character"), function(self, from, to, attr) { .verifyNodes(from, nodes(self)) gEdges <- edges(self)[from] lens <- sapply(gEdges, length) fEdges <- rep(from, lens) if (!length(fEdges)) return(list()) tEdges <- unlist(gEdges) edgeKeys <- .getEdgeKeys(self, fEdges, tEdges) attrDataItem(self@edgeData, x=edgeKeys, attr=attr) }) setMethod("edgeData", signature(self="graph", from="missing", to="character", attr="character"), function(self, from, to, attr) { eDat <- edges(self) inE <- inEdges(to, self) to <- rep(to, sapply(inE, length)) from <- unlist(inE) ## from <- names(eDat)[sapply(eDat, function(x) to %in% x)] edgeKeys <- .getEdgeKeys(self, from, to) attrDataItem(self@edgeData, x=edgeKeys, attr=attr) }) setReplaceMethod("edgeData", signature(self="graph", from="character", to="character", attr="character", value="ANY"), function(self, from, to, attr, value) { edgeKeys <- .getEdgeKeys(self, from, to) attrDataItem(self@edgeData, x=edgeKeys, attr=attr) <- value if (!isDirected(self)) { edgeKeys <- .getEdgeKeys(self, to, from) attrDataItem(self@edgeData, x=edgeKeys, attr=attr) <- value } self }) setReplaceMethod("edgeData", signature(self="graph", from="character", to="missing", attr="character", value="ANY"), function(self, from, to, attr, value) { .verifyNodes(from, nodes(self)) gEdges <- edges(self)[from] lens <- sapply(gEdges, length) if (any(lens == 0)) warning("no edges from nodes: ", pasteq(from[lens == 0])) fEdges <- rep(from, lens) tEdges <- unlist(edges(self)[from]) edgeKeys <- .getEdgeKeys(self, fEdges, tEdges) attrDataItem(self@edgeData, x=edgeKeys, attr=attr) <- value if (!isDirected(self)) { edgeKeys <- .getEdgeKeys(self, tEdges, fEdges) attrDataItem(self@edgeData, x=edgeKeys, attr=attr) <- value } self }) setReplaceMethod("edgeData", signature(self="graph", from="missing", to="character", attr="character", value="ANY"), function(self, from, to, attr, value) { eDat <- edges(self) from <- names(eDat)[sapply(eDat, function(x) to[1] %in% x)] edgeKeys <- .getEdgeKeys(self, from, to) attrDataItem(self@edgeData, x=edgeKeys, attr=attr) <- value if (!isDirected(self)) { edgeKeys <- .getEdgeKeys(self, to, from) attrDataItem(self@edgeData, x=edgeKeys, attr=attr) <- value } self }) .getAllEdges <- function(graph) { e1 <- edges(graph) if (length(e1) == 0L) { list(from=character(0), to=character(0)) } else { n1 <- nodes(graph) n1 <- rep(n1, sapply(e1, length)) list(from=n1, to=unlist(e1)) } } setMethod("edgeData", signature(self="graph", from="missing", to="missing", attr="character"), function(self, from, to, attr) { eSpec <- .getAllEdges(self) from <- eSpec$from to <- eSpec$to edgeKeys <- .getEdgeKeys(self, from, to) attrDataItem(self@edgeData, x=edgeKeys, attr=attr) }) setMethod("edgeData", signature(self="graph", from="character", to="character", attr="missing"), function(self, from, to, attr) { edgeKeys <- .getEdgeKeys(self, from, to) attrDataItem(self@edgeData, x=edgeKeys) }) setMethod("edgeData", signature(self="graph", from="missing", to="missing", attr="missing"), function(self, from, to, attr) { eSpec <- .getAllEdges(self) from <- eSpec$from to <- eSpec$to edgeKeys <- .getEdgeKeys(self, from, to) attrDataItem(self@edgeData, x=edgeKeys) }) ## still needed for Rgraphviz' plot() [well, as long as edgeL() is still there] setMethod("edgeL", "graph", function(graph, index) callGeneric(as(graph, "graphNEL"))) setMethod("plot", c("graph", "ANY"), function(x, y, ...) { qrequire("Rgraphviz") method <- getMethod("plot", c("graph", "ANY"), getNamespace("Rgraphviz")) method(x, y, ...) }) clearEdgeData <- function(self, from, to) { ##FIXME: make me a method edgeKeys <- .getEdgeKeys(self, from, to) removeAttrDataItem(self@edgeData, x=edgeKeys) <- NULL self } clearNodeData <- function(self, n) { ##FIXME: make me a method removeAttrDataItem(self@nodeData, x=n) <- NULL self } graph/R/reverseEdgeDirections.R0000644000175000017500000000047214136046755016333 0ustar nileshnileshreverseEdgeDirections <- function(g) { ## FIXME: This needs to fix edge attributes, but for now, we punt ## and we are only using node attrs here anyhow... gam <- as(g, "graphAM") nodeNames <- nodes(g) gam@adjMat <- t(gam@adjMat) colnames(gam@adjMat) <- nodeNames as(gam, "graphNEL") } graph/R/AllClasses.R0000644000175000017500000000720014136046755014071 0ustar nileshnilesh## Classes for representing graphs setClass("attrData", representation(data="list", defaults="list")) ## (FH Oct 4.) The edgemode slot is deprecated, the information will ## go into the egemode item of the graphData list. setClass("graphBase") ## class to hold information regarding rendering of a graph. Doesn't ## make sense except as a slot in a graph (the names have to match) setClass("renderInfo", representation(nodes="list", # information on nodes edges="list", # information on edges graph="list", pars="list")) # list passed on to graph.par before rendering setClass("graph", representation(## edgemode="character", edgeData="attrData", nodeData="attrData", renderInfo="renderInfo", ## nodeInfo="list", ## edgeInfo="list", graphData="list", "VIRTUAL"), contains = "graphBase") ## Node Edge List representation setClass("graphNEL", contains="graph", representation(nodes="vector", edgeL="list"), validity=function(object) validGraph(object)) ## Adjacency Matrix representation setClass("graphAM", contains="graph", representation(adjMat="matrix"), validity=function(object) validGraph(object)) setClass("distGraph", representation(Dist="dist"), prototype=list(graphData=list(edgemode="undirected")), contains="graph") setClass("clusterGraph", representation(clusters="list"), contains="graph", prototype=list(graphData=list(edgemode="undirected"))) ## Misc classes setClass("simpleEdge", representation(edgeType="character", weight="numeric", directed="logical", bNode="character", ##begin - if directed eNode="character"), ##end - if directed prototype=list(edgeType="unknown", directed=FALSE, bNode="", eNode="", weight=1)) ##multigraphs - not clear if we should extend graph here, or have a ##whole new set of classes ##looks like redefining edgeSets is going to help us out here. setClass("edgeSet", contains="VIRTUAL", representation=representation( edgeData="attrData")) setClass("edgeSetNEL", contains="edgeSet", representation(edgemode="character", edgeL="list")) setClass("edgeSetAM", contains="edgeSet", representation(edgemode="character", adjMat="matrix")) setClass("multiGraph", representation(nodes="vector", edgeL="list", nodeData="attrData", graphData="list")) setClass("MGEdgeSet", representation = representation( bit_vector = "raw", weights = "numeric", edge_attrs = "list")) setClass("DiEdgeSet", contains = "MGEdgeSet") setClass("UEdgeSet", contains = "MGEdgeSet") setClass("attrPos", representation = representation( nodePos = "list", edgePos = "list")) setClass("MultiGraph", representation = representation( nodes = "character", nodeData = "attrData", ## items will be MGEdgeSet objects edge_sets = "list", edge_defaults = "list", userAttrPos = "attrPos"), contains = "graphBase") setClass("graphBAM", contains = "graph", representation(edgeSet = "MGEdgeSet", nodes = "character", userAttrPos = "attrPos")) graph/R/graphNEL.R0000644000175000017500000005130414136046755013507 0ustar nileshnileshvalidGraph<-function(object, quietly=FALSE) { ## FIXME: we are doing if/else branching here on ## specific subclasses of graph. We should make this a generic ## so we can organize checking. Also, graphAM is not ## currently being checked in any way. bad = FALSE if (is(object, "graphNEL")) { objEdges<-edges(object) objNodes<-nodes(object) if (any(is.na(objNodes))) { if (!quietly ) cat("NA element in nodes.\n") bad <- TRUE } if(length(objEdges)>0) if(any(is.na(unlist(objEdges,use.names=FALSE)))) { if(!quietly) cat("NA element in edges.\n") bad <- TRUE } ##don't think we want to force this one ## if (length(objNodes)!=length(objEdges)) { ## if( !quietly ) ## cat("Nodes and edges must have the same length.\n") ## bad <- TRUE ## } if (!all( names(objEdges) %in% objNodes )) { if( !quietly ) cat("Edges don't have the same names as the nodes.\n") bad <- TRUE } if (any(duplicated(objNodes))) { if( !quietly ) cat("Node names may not be duplicated\n") bad <- TRUE } ##check for reciprocity in undirected graphs ##paste to->from and from->to if any are not duplicated then ##the edge is not reciprocal. Note we are not going to handle ##multiedges well. if(edgemode(object) == "undirected" && length(objEdges)>0 ) { fr <- rep(names(objEdges), sapply(objEdges, length)) to <- unlist(objEdges) frto <- paste(fr, to, sep=EDGE_KEY_SEP) tofr <- paste(to, fr, sep=EDGE_KEY_SEP) badEdges <- setdiff(tofr, frto) if (length(badEdges) > 0) { if (!quietly) { cat("the graph is undirected and the following edges", "are not reciprocated:\n", pasteq(badEdges), "\n\n") } bad <- TRUE } } } else if( is(object, "distGraph") ) { if( is(object@Dist, "dist") ) return(TRUE) else return(FALSE) } return(!bad) } setMethod("initialize", "graphNEL", function(.Object, ...) { .Object <- callNextMethod() validObject(.Object) return(.Object) }) graphNEL_init_edges_nested <- function(nodes, edgeL) { if(length(nodes) != length(edgeL) ) stop("'nodes' and 'edgeL' must have same length") nameE <- names(edgeL) if( !is.null(nameE) && !all( nameE %in% nodes) ) stop("'edgeL' names must agree with 'nodes'") if( !is.null(nameE) ) edgeL <- edgeL[nodes] edgeL <- lapply(edgeL, function(x) { if (is.character(x$edges)) x$edges <- match(x$edges, nodes) if (is.null(x) || is.null(x$edges)) x <- list(edges=numeric(0)) x }) edgeL } graphNEL_init_edgeL_weights <- function(gnel) { defaultWeight <- 1 edgeDataDefaults(gnel, attr="weight") <- defaultWeight edgeL <- gnel@edgeL wts <- unlist(lapply(edgeL, function(x) { w <- x$weights if (is.null(w) || length(w) == 0) return(rep(defaultWeight, length(x$edges))) w })) if (!is.numeric(wts)) stop("weights in edgeL must be numeric") eSpec <- .getAllEdges(gnel) from <- eSpec$from to <- eSpec$to edgeData(gnel, from=from, to=to, attr="weight") <- wts ## remove weights, since now stored in the edgeData edgeL <- lapply(edgeL, function(x) x["edges"]) gnel@edgeL <- edgeL gnel } graphNEL_init_edges <- function(nodes, edges) { nameE <- names(edges) if (is.null(nameE) || !all(nameE %in% nodes)) stop("'edges' names must agree with 'nodes'") if (any(unlist(lapply(edges, is.list)))) stop("'edges' must be list of character()") ##merge all edges with same names if(any(duplicated(nameE))){ edges <- split(edges, nameE) edges <- lapply(edges, unlist) nameE <- names(edges) } ##melt list m <- sapply(edges, length) n <- m > 0 els <- edges[n] edgeF <- rep(names(els), m[n]) edgeT <- unlist(els) edgeL <- unname(cbind(edgeF, edgeT)) if(sum(n)>0){ eL <- match(edgeL[, 2], nodes) edgeL <- split(eL, edgeL[, 1]) edgeL <- c(edgeL, lapply(edges[!n], function(x) integer(0))) }else{ edgeL <- lapply(edges, function(x) integer(0)) } edgeL <- edgeL[nameE] edgeL <- lapply(edgeL, function(x) list(edges=x)) edgeL } setMethod("initialize", "graphNEL", function(.Object, nodes=character(0), edgeL, edgemode) ## FIXME: what about edge weights? { if (length(nodes)) checkValidNodeName(nodes) if( missing(edgemode) ) edgemode <- "undirected" doWeights <- FALSE if (missing(edgeL) || (!is.null(edgeL) && length(edgeL) == 0)) { edgeL <- vector(mode="list", length=length(nodes)) names(edgeL) <- nodes } else { ## which list structure was used? edgeParser <- graphNEL_init_edges firstVal <- edgeL[[1]] if (is.null(firstVal)) stop("'edgeL' must be list of character or list of lists, got NULL") if (length(edgeL) > 0 && is.list(edgeL[[1]])) { edgeParser <- graphNEL_init_edges_nested doWeights <- TRUE } edgeL <- edgeParser(nodes, edgeL) } .Object@nodes <- nodes .Object@edgeL <- edgeL .Object@graphData$edgemode <- edgemode validObject(.Object) if (doWeights) .Object <- graphNEL_init_edgeL_weights(.Object) return(.Object) }) ##the graphNEL representation stores edges as indexes into the ##node label vector setMethod("edges", "graphNEL", function(object, which) { edgeL <- object@edgeL if (!missing(which)) { if (!is.character(which)) stop("'Nodes' must be missing or a character vector") edgeL <- edgeL[which] } gNodes <- nodes(object) lapply(edgeL, function(x) gNodes[x$edges]) }) setMethod("adj", c("graphNEL", "ANY"), function(object, index) { initI <- as.character(index) nd <- nodes(object) if( is.character(index) ) index <- match(index, nd) bad_idx <- which(is.na(index) | index < 0L | index > length(nd)) if( length(bad_idx) != 0L ) { what <- if( length(bad_idx) == 1L ) "vertex is" else "vertices are" in1string <- paste(sQuote(initI[bad_idx]), collapse=", ") stop(what, " not in graph: ", in1string) } edges(object)[index]}) setMethod("edgeL", "graphNEL", function(graph, index) { if( missing(index) ) graph@edgeL else graph@edgeL[index]}) setMethod("subGraph", signature(snodes="character", graph="graphNEL"), function(snodes, graph) { origNodes <- nodes(graph) snodesIdx <- match(snodes, origNodes) if (any(is.na(snodesIdx))) { bad <- snodes[which(is.na(snodesIdx))] stop("'snodes' contains nodes not in graph: ", pasteq(bad)) } killedNodes <- origNodes[-snodesIdx] newEdges <- lapply(edges(graph)[snodes], function(x) { whD <- match(killedNodes, x, nomatch=0) if (any(whD)) x[-whD] else x }) ans <- graphNEL(nodes=snodes, edgeL=newEdges, edgemode=edgemode(graph)) ## FIXME: need to clean the attributes, right now we are passing ## too much. nodeIdx <- match(snodes, names(graph@nodeData), 0) ans@nodeData@defaults <- graph@nodeData@defaults ans@nodeData@data <- graph@nodeData@data[nodeIdx] ee <- .getAllEdges(ans) if (length(ee$from) && length(ee$to)) { kk <- .makeEdgeKeys(ee$from, ee$to) whkk <- match(kk, names(graph@edgeData), 0) ans@edgeData@defaults <- graph@edgeData@defaults ans@edgeData@data <- graph@edgeData@data[whkk] } ans }) setMethod("numNodes", "graphNEL", function(object) length(object@nodes)) setMethod("addNode", signature(node="character", object="graphNEL", edges="missing"), function(node, object, edges) { gN = nodes(object) already <- match(node, gN) if( any(!is.na(already)) ) stop("node(s) already in graph: ", pasteq(gN[already])) checkValidNodeName(node) ## add them on the end so we don't renumber gN = c(gN, node) edgeL <- object@edgeL nEd <- vector("list", length=length(node)) names(nEd) <- node for(i in seq(along=nEd)) nEd[[i]] <- list(edges=numeric(0)) edgeL <- c(edgeL, nEd) object@nodes <- gN object@edgeL <- edgeL object }) ##they need to supply a list of edges, one for each element of node ##it might be better to do this by first adding the nodes then ##calling addEdges on that graph setMethod("addNode", signature(node="character", object="graphNEL", edges="list"), function(node, object, edges) { ## first add the nodes, it does the checking too object <- addNode(node, object) ## now add the edges: if (!all(names(edges) == node)) stop("'edges' must be named and in the same order as nodes") doWeights <- FALSE newEdges <- lapply(edges, function(x) { if (is.character(x)) x else if (is.numeric(x)) { doWeights <<- TRUE ## set flag in function scope if (length(x) == 0) enms <- character(0) else enms <- names(x) if (is.null(enms)) stop("'edges' must be character or have names ", "corresponding to nodes") enms } else { stop("'edges' must be character or numeric list elements") } }) for (i in seq(along=newEdges)) { if (length(newEdges[[i]]) == 0) next if (doWeights) object <- addEdge(from=node[i], to=newEdges[[i]], object, weights=edges[[i]]) else object <- addEdge(from=node[i], to=newEdges[[i]], object) } object }) setMethod("removeNode", c("character", "graphNEL"), function(node, object) { ##first clear the node -- does the checking too object <- clearNode(node, object) nN <- nodes(object) wh <- match(node, nN) gN <- nN[-wh] nE <- object@edgeL[-wh] ## Now renumber the nodes as stored in the edgelist nE2 <- lapply(nE, function(el) { oldN <- nN[el$edges] el$edges <- match(oldN, gN) el }) object@nodes <- gN object@edgeL <- nE2 object }) setMethod("clearNode", c("character", "graphNEL"), function(node, object) { gN <- nodes(object) whN <- match(node, gN) if(any(is.na(whN)) ) stop("'node' not in graph: ", pasteq(gN[is.na(whN)])) ## clear node attributes object <- clearNodeData(object, node) object <- .dropEdges(object, whN) object@edgeL[whN] <- list(list(edges=numeric(0))) object }) edgeKiller <- function(edgeL, from, whichKill) { for (i in seq(along=from)) { toKill <- whichKill[[i]] toKill <- toKill[!is.na(toKill)] if (length(toKill) == 0) stop("no edge 'from' ", sQuote(from[i]), " to remove") edgeL[[from[i]]]$edges <- edgeL[[from[i]]]$edges[-toKill] } edgeL } setMethod("removeEdge", signature(from="character", to="character", graph="graphNEL"), function(from, to, graph) { gN <- nodes(graph) wh <- match(c(from, to), gN) if( any(is.na(wh)) ) stop("'from' or 'to' not in graph: ", pasteq(unique(wh[is.na[wh]]))) if (length(to) == 1) to <- rep(to, length(from)) if (length(from) == 1) from <- rep(from, length(to)) if (!isDirected(graph)) { fromOrig <- from from <- c(fromOrig, to) to <- c(to, fromOrig) remove(fromOrig) } graph <- clearEdgeData(graph, from, to) remEL <- split(to, from) fromU <- names(remEL) nE <- edges(graph, fromU) whD <- mapply(function(x, y) match(x, y), remEL, nE, SIMPLIFY=FALSE) graph@edgeL <- edgeKiller(graph@edgeL, fromU, whD) graph }) setMethod("addEdge", signature=signature(from="character", to="character", graph="graphNEL", weights="numeric"), function(from, to, graph, weights) { graph <- addEdge(from, to, graph) if (!("weight" %in% names(edgeDataDefaults(graph)))) edgeDataDefaults(graph, attr="weight") <- 1L edgeData(graph, from=from, to=to, attr="weight") <- weights graph }) setMethod("addEdge", signature=signature(from="character", to="character", graph="graphNEL", weights="missing"), function(from, to, graph) { preEdges <- isAdjacent(graph, from, to) if (any(preEdges)) { preFr <- from[preEdges] preTo <- to[preEdges] preEdges <- paste(preFr, preTo, sep=EDGE_KEY_SEP) warning("edges replaced: ", pasteq(preEdges)) } gN <- nodes(graph) whF <- match(from, gN) if( any(is.na(whF)) ) stop("not a node: ", pasteq(from[is.na(whF)])) whT <- match(to, gN) if( any(is.na(whT)) ) stop("not a node: ", pasteq(to[is.na(whT)])) ##roll out the shorter one lenT <- length(to) lenF <- length(from) if( lenT > lenF ) { from <- rep(from, lenT) whF <- rep(whF, lenT) } if( lenF > lenT ) { whT <- rep(whT, lenF) to <- rep(to, lenF) } ##now the same lenN <- max(lenT, lenF) eL <- graph@edgeL for(i in seq_len(lenN)) { old <- eL[[from[i]]] ## remove duplicate edges old$edges <- unique(c(old$edges, whT[i])) eL[[from[i]]] <- old } ##if undirected, then we need to go in both directions if( edgemode(graph) == "undirected") for(i in seq_len(lenN)) { old <- eL[[to[i]]] ## remove duplicate edges old$edges <- unique(c(old$edges, whF[i])) eL[[to[i]]] <- old } graph@edgeL <- eL ##FIXME: should we call validObject here? graph }) ## Collapse a set of nodes and the corresponding edges setMethod("combineNodes", c("character", "graphNEL", "character"), function(nodes, graph, newName, collapseFunction=sum) { if( length(newName) > 1 ) stop("'newName' must have length 1") gN <- nodes(graph) whN <- match(nodes, gN) if( anyNA(whN) ) stop("not a node: ", pasteq(nodes[is.na(whN)])) eL <- graph@edgeL outE <- eL[nodes] if( length(nodes) == 1 ) { warning("nothing to collapse") return(graph) } ##function to collapse weights for combined edges collapseFunction <- match.fun(collapseFunction) ##if undirected then we know everything inE <- if( edgemode(graph) == "directed" ) inEdges(nodes, graph) else NULL g2 <- removeNode(nodes, graph) g2 <- addNode(newName, g2) oE <- gN[unlist(lapply(outE[nodes], "[[", "edges"), use.names=FALSE)] oW <- unlist(edgeWeights(graph, nodes), use.names=FALSE) if (is.null(oW)) oW <- rep(1, length(oE)) toW <- tapply(oW, oE, collapseFunction)[setdiff(unique(oE), nodes)] ##there might be no edges to add if(length(toW)) g2 <- addEdge(newName, names(toW), g2, as.numeric(toW)) ##if directed we need to fix up the incoming edges if( !is.null(inE) ) { inE <- lapply(inE, setdiff, nodes) inEl <- unique(unlist(inE), use.names=FALSE) oW <- as.numeric(sapply(edgeWeights(graph, inEl), function(x) collapseFunction(x[intersect(names(x), nodes)]))) if(length(inEl)) g2 <- addEdge(inEl, newName, g2, oW) } g2 }) ##inEdges returns a list of all nodes with edges ##to the nodes in "node" setMethod("inEdges", c("missing", "graphNEL"), function(node, object) inEdges(nodes(object), object)) ##seems more sensible - if there is only one arg setMethod("inEdges", c("graphNEL", "missing"), function(node, object) inEdges(nodes(node), node)) setMethod("inEdges", c("character", "graphNEL"), function(node, object) { gN <- nodes(object) whN <- match(node, gN) if( any(is.na(whN)) ) stop("not a node: ", pasteq(node[is.na(whN)])) nN <- length(node) rval <- vector("list", length=nN) names(rval) <- node eL <- object@edgeL for (i in seq_len(nN)) { whOnes <- sapply(eL, function(x) { if (whN[i] %in% x$edges) return(TRUE) FALSE }) rval[[i]] <- gN[whOnes] } rval }) .dropEdges <- function(self, x) { ## Remove all edges in graphNEL self to node with ## index x. Also remove all edges from node with index x. ## Return the modified graphNEL. ## Removing edges also removes the associated attributes. oldEdgeL <- self@edgeL newEdgeL <- vector(mode="list", length=length(oldEdgeL)) names(newEdgeL) <- names(oldEdgeL) nds <- nodes(self) for (i in seq(along=nds)) { toList <- oldEdgeL[[i]]$edges if (i %in% x) { to <- nds[toList] if (length(to)) self <- clearEdgeData(self, from=nds[i], to=to) toList <- list(edges=numeric(0)) } else { bad <- match(x, toList) bad <- bad[!is.na(bad)] if (length(bad)) { self <- clearEdgeData(self, from=nds[i], to=nds[toList[bad]]) toList <- list(edges=toList[-bad]) } else { toList <- list(edges=toList) } } newEdgeL[[nds[i]]] <- (toList) } self@edgeL <- newEdgeL self } ##a leaf is an element of the graph with in edges and no out ## edges - the edgeL list in a directed graphNEL list the out ##edges inOutCounts <- function(object) { if(!(edgemode(object)) == "directed") stop("only for directed graphs") numOut=sapply(object@edgeL, function(x) length(x$edges)) inEdges = nodes(object)[unlist(sapply(object@edgeL, function(x) x$edges))] numIn = table(inEdges) return(list(numOut = numOut, numIn = numIn)) } ##FIXME: this is a replacement for the inEdges function - ##it needs to be tested and made to handle a list of ##nodes to find in edges - but that can easily be done ##simply by computing all and then subsetting inE <- function(object) { if(!(edgemode(object)) == "directed") stop("only for directed graphs") inEdges = nodes(object)[unlist(sapply(object@edgeL, function(x) x$edges))] numE = sapply(object@edgeL, function(x) length(x$edges)) froms = rep(names(object@edgeL), numE) split(froms, inEdges) } graph/R/clustergraph.R0000644000175000017500000002436314136046755014557 0ustar nileshnilesh##copyright 2002 R. Gentleman, all rights reserved ## a simple implementation of the notions of cluster graphs ## and clustering using distance measures ## for the adjacency matrix view of undirected graphs the ## storage of the graph in lower triangular form is appealing ## The lower triangle of the distance matrix stored by columns in a ## single vector. The vector has the attributes `"Size"', `"Diag"', ## `"Upper"', `"Labels"' and `"class"' equal to `"dist"'. ## the lower triangle stored by columns ## for i < j <= n the dissimilarity between row i and j is ## x[n*(i-1)-i*(i-1)/2+j-i] ## size is the number of obs ## labels are their labels, Diag and Upper indicate how to print ## ##a function for Martin -- if it ever gets good enough. ##FIXME: should look at other matrix packages; this is just subsetting ##from a lower (or upper) triangular matrix representation -- which ##should be easier...but maybe it needs to be done in C "[.dist" <- function(x, i, j, drop=TRUE) { lend <- attr(x, "Size") if( missing(i) ) if( missing(j) ) return(x) else { ## return columns i <- seq_len(lend) } if( missing(j) ) { j <- seq_len(lend) } ## we have both -- return a matrix leni <- length(i) lenj <- length(j) outl <- leni*lenj iuse <- rep(i, length.out=outl) juse <- rep(j, rep(leni, lenj), length.out=outl) igtj <- iuse > juse newi <- ifelse(!igtj, iuse, juse) newj <- ifelse(igtj, iuse, juse) lend <- attr(x, "Size") subs <- lend*(newi-1)-newi*(newi-1)/2+newj-newi zeros <- newi==newj rval <- rep(0, length(subs)) subs <- subs[!zeros] sdata <- unclass(x)[subs] rval[!zeros]<-sdata labels <- attr(x, "Labels") if( drop && (lenj == 1 || leni==1) ) { out<-rval if( leni == 1 ) names(out) <- labels[j] else names(out) <- labels[i] } else { out <- matrix(rval, ncol=lenj, nrow=leni) dimnames(out) <- list(labels[i], labels[j]) } out } setMethod("initialize", "distGraph", function(.Object, Dist) { if( is.null( attr(Dist, "Labels") ) ) attr(Dist, "Labels") = as.character(seq_len(attr(Dist, "Size"))) else checkValidNodeName(attr(Dist, "Labels")) .Object@Dist = Dist .Object }) setMethod("Dist", "distGraph", function(object) object@Dist) setMethod("show", "distGraph", function(object) { cat("distGraph with ", attr(object@Dist, "Size"), " nodes \n", sep="")}) setMethod("threshold", "distGraph", function(object, k, value=0) { nd <- object@Dist nd[nd > k ] <- value new("distGraph", Dist=nd) }) setMethod("addNode", c("character", "distGraph", "list"), function(node, object, edges) { gN = nodes(object) nNode = length(gN) nAdd = length(node) numE = sapply(edges, length) if( any(numE != nNode+nAdd) ) stop("must supply all internode distances") newN <- c(gN, node) nmE <- names(edges) if( length(nmE) != nAdd || any(!(names(edges) %in% node))) stop("edges must be named") edges <- edges[node] lapply(edges, function(x) if(any( !(names(x) %in% newN) ) ) stop("bad edge specification")) ordE <- lapply(edges, function(x) x[newN]) subM <- sapply(ordE, function(x) x) ##should be a matrix! oldD <- as.matrix(Dist(object)) f1 <- cbind(oldD, subM[seq_len(nNode),]) f2 <- rbind(f1, t(subM)) rv <- new("distGraph", Dist = as.dist(f2)) }) setMethod("numNodes", "distGraph", function(object) attr(Dist(object), "Size")) setMethod("adj", c("distGraph", "ANY"), function(object, index) { nodenames<- nodes(object) if( is.character(index) ) index <- match(index, nodenames) if( !is.numeric(index) ) stop("'index' not recognized") adjM <- object@Dist[index,] if( is.matrix(adjM) ) adjL <- split(adjM, row(adjM)) else adjL <- list(adjM) for(i in seq_along(adjL)) adjL[[i]] <- names(adjL[[i]])[adjL[[i]] > 0 ] return(adjL) }) setMethod("edges", "distGraph", function(object, which) { nN <- nodes(object) if (!missing(which)) { if (!is.character(which)) stop("'which' must be missing or a character vector") wh <- match(which, nN) if( any(is.na(wh)) ) stop("'which' nodes not all in graph") nN <- nN[wh] } eL <- lapply(nN, function(x) adj(object, x)[[1]]) names(eL) <- nN eL}) ## FIXME: update for new attribute storage setMethod("edgeWeights", "distGraph", function(object, index, attr, default, type.checker) { edg <- edges(object) if( !missing(index) ) edg <- edg[index] NODES <- nodes(object) edLocs <- match(names(edg), NODES) edE <- lapply(edg, function(x) match(x, NODES)) for( i in seq(along=edLocs) ) edE[[i]] <- object@Dist[edLocs[i], edE[[i]]] names(edE) <- names(edg) edE }) setMethod("subGraph", c("character", "distGraph"), function(snodes, graph) { gN <- nodes(graph) whN <- match(snodes, gN) if( any(is.na(whN) ) ) stop("'snodes' not all in graph") nD <- as.matrix(Dist(graph))[whN, whN] new("distGraph", Dist=as.dist(nD)) }) setMethod("edgeL", "distGraph", function(graph, index) { edges <- edges(graph) edgeL <- mapply(function(x, y, nodes) { out <- list(edges=match(x, nodes), weights=y) }, edges, edgeWeights(graph), MoreArgs=list(nodes=nodes(graph)), SIMPLIFY=FALSE) names(edgeL) <- names(edges) if (! missing(index)) edgeL <- edgeL[[index]] edgeL }) #################################### ##clusterGraph code here #################################### # setMethod("initialize", "clusterGraph", function(.Object, clusters) { # if( is.factor(clusters) ) # clusters = split(names(clusters), clusters) # .Object@clusters = clusters # .Object # }) setMethod("edges", "clusterGraph", function(object, which) { if (!missing(which)) { if (!is.character(which)) stop("'which' must be missing or a character vector") nN <- nodes(object) wh <- match(which, nN) if( any(is.na(wh)) ) stop("'which' nodes not all in graph") } edges<-list() for(clust in object@clusters) { cc <- as.character(clust) if (!missing(which)) cc <- intersect(cc, which) for(i in seq(along=cc) ) edges[[cc[i]]] <- cc[-i] } if (!missing(which)) edges <- edges[which] edges }) setMethod("edgeL", "clusterGraph", function(graph, index) { clusters <- connComp(graph) nodes <- nodes(graph) edgeL <- list() cur <- 1 for (i in seq(along=clusters)) { curClust <- clusters[[i]] for (j in seq(along = curClust)) { edgeL[[cur]] <- list(edges=match(curClust[-j], nodes)) cur <- cur + 1 } } names(edgeL) <- nodes if (! missing(index)) edgeL <- edgeL[[index]] edgeL }) ##FIXME: this should be done from distances, but for now...) ##eg, if a distance matrix was supplied we could use that to define ##edge weights -- as that seems appropriate ## FIXME: update for new attr storage setMethod("edgeWeights", "clusterGraph", function(object, index, attr, default, type.checker) { edg <- edges(object) if( !missing(index) ) edg <- edg[index] ans <- lapply(edg, function(x) { ans <- rep(1, length(x)); names(ans) <- x; ans}) ans}) setMethod("subGraph", c("character", "clusterGraph"), function(snodes, graph) { cList <- graph@clusters cL <- lapply(cList, function(x) intersect(x, snodes)) graph@clusters <- cL graph}) setMethod("numNodes", "clusterGraph", function(object) sum(sapply(object@clusters, length))) setMethod("adj", c("clusterGraph", "ANY"), function(object, index) { nIndex <- length(index) if( any(is.na(match(index, nodes(object)))) ) stop("invalid node label") rval <- vector("list", length=nIndex) names(rval) <- index for(i in seq_len(nIndex)) { for(cl in object@clusters) if( index[i] %in% cl ) rval[[i]] <- cl } return(rval)}) ##for cluster graphs, acc and adj are the same setMethod("acc", c("clusterGraph", "character"), function(object, index) { nIndex <- length(index) if( any(is.na(match(index, nodes(object)))) ) stop("invalid node label") rval <- vector("list", length=nIndex) names(rval) <- index for(i in seq_len(nIndex)) { for(cl in object@clusters) if( index[i] %in% cl ) rval[[i]] <- cl } return(rval)}) setMethod("connComp", "clusterGraph", function(object) object@clusters) setMethod("show", "clusterGraph", function(object) { numNull<-numNoEdges(object) numNodes<- numNodes(object) numEdge<-numEdges(object) cat("A graph with ", edgemode(object), " edges\n") cat("Number of Nodes = ",numNodes,"\n",sep="") cat("Number of Edges = ",numEdge,"\n",sep="") }) setAs(from="clusterGraph", to="matrix", function(from, to) { theNodes <- nodes(from) # will be grouped by cluster! numNodes <- length(theNodes) m <- matrix(0, nrow=numNodes, ncol=numNodes, dimnames=list(theNodes, theNodes)) for (clust in from@clusters) { idx <- match(clust, theNodes) m[idx, idx] <- 1 } diag(m) <- 0 # eliminate self-loops m }) graph/R/TODOT.R0000644000175000017500000000753714136046755012751 0ustar nileshnilesh #setClass("compoundGraph", # representation(grList="list", # between="list")) #setMethod("grList","compoundGraph", function(object)object@grList) # #setMethod("between", "compoundGraph", function(object)object@between) setMethod("toDotR", c("graphNEL", "character", "list", "list"), function (G, outDotFile, renderList, optList=.standardToDotOptions) { buildEdge <- function(fromTok, toTok, opts, labField=NULL) { protq <- function(x) paste0("\"",x,"\"") core <- paste(protq(fromTok),"->",protq(toTok),";\n",sep=" ") UDB <- opts$useDirBack ELF <- opts$edgeLabelField if (length(UDB) == 0) UDB <- FALSE if (length(ELF) == 0 || nchar(ELF) == 0 || is.null(labField)) ELF <- FALSE else ELF <- TRUE if (!UDB & !ELF) return(core) if (UDB & !ELF) return(paste("edge [dir=back]", core, sep=" ")) if (!UDB & ELF) return( paste0("edge [label=", labField,"] ", core)) if (UDB & ELF) return(paste0("edge [dir=back label=", labField,"] ", core)) stop("logic error") } ## to get bottom to top orientation (B points up to A), use ## [dir=back] A->B if (is.null(renderList$start)) renderList$start <- "digraph G" out <- paste0(renderList[["start"]], " {\n") ned <- length(E <- edgeL(G)) enms <- names(E) nds <- nodes(G) ac <- as.character if (!is.null(pn <- renderList[["prenodes"]])) out <- paste(out, pn, "\n") ## need quote marks protq <- function(x) paste0("\"", x, "\"") ## this takes care of isolated nodes if present for (j in nds) out <- paste( out, protq(j), ";\n" ) ## deal with an edge statement if (!is.null(pe <- renderList[["preedges"]])) out <- paste(out, pe, "\n") if (ned > 0) for (i in seq_len(ned)) { if ((L <- length(E[[i]]$edges)) > 0) for (j in seq_len(L)) { builtEdge <- buildEdge(from=nds[ E[[i]]$edges[j] ], to=enms[i], optList, E[[i]][[ optList$edgeLabelField ]]) out <- paste(out, builtEdge, sep=" ") } } out <- paste(out, "}\n", sep = "", collapse = "") if (outDotFile != ".AS.STRING") { cat(out, file = outDotFile) paste("dot file written to", sQuote(outDotFile), " use 'dot -Tps [.dot] [.ps] to render.\n") invisible(0) } else out }) setMethod("toDotR", c("graphNEL", "character", "missing", "missing"), function(G, outDotFile, renderList, optList) toDotR(G, outDotFile, list(start="digraph G"), .standardToDotOptions)) # where=where) setMethod("toDotR", c("graphNEL", "missing", "missing", "missing"), function(G, outDotFile, renderList, optList) toDotR(G, , list(start="digraph G"), .standardToDotOptions)) #where=where) setMethod("toDotR", c("graphNEL", "missing", "character", "missing"), function (G, outDotFile, renderList, optList) toDotR(G, ".AS.STRING", list(start=renderList," "), .standardToDotOptions)) # where=where) setMethod("toDotR", c("graphNEL", "missing", "list", "list"), function(G, outDotFile, renderList, optList) toDotR(G, ".AS.STRING" , renderList, optList)) # where=where) setMethod("toDotR", c("graphNEL", "missing", "list", "missing"), function(G, outDotFile, renderList, optList) toDotR(G, ".AS.STRING" , renderList, .standardToDotOptions)) # where=where) setMethod("toDotR", c("graphNEL", "missing", "missing", "list"), function(G, outDotFile, renderList, optList) toDotR(G, ".AS.STRING" , list(start="digraph G"), optList)) # where=where) setMethod("toDotR", c("graphNEL", "character", "missing", "list"), function(G, outDotFile, renderList, optList) toDotR(G, outDotFile , list(start="digraph G"), optList)) # where=where) .standardToDotOptions <- list( useDirBack=TRUE ) graph/R/edgefunctions.R0000644000175000017500000001207014136046755014701 0ustar nileshnilesh################################################################ # function: # aveNumEdges takes one parameter: # objgraph is the graph object # aveNumEdges counts the number of edges in the graph and divides # that by the number of nodes in the graph to give the # average number of edges. A double representing the average # number of edges will be returned. # # created by: Elizabeth Whalen # last updated: July 22, 2002 ################################################################ aveNumEdges<-function(objgraph) numEdges(objgraph)/length(nodes(objgraph)) ################################################################ # function: # calcProb takes two parameters: # origgraph is the original graph from which the subgraph was made # subgraph is the subgraph made from the original graph # calcProb calculates the probability of having the number of edges # found in the subgraph given that it was made from origgraph. # The hypergeometric distribution is used to calculate the # probability (using the pdf). # # created by: Elizabeth Whalen # last updated: July 22, 2002 ################################################################ calcProb <- function(subgraph, origgraph) { origNumNodes<-length(nodes(origgraph)) subNumNodes<-length(nodes(subgraph)) origNumEdges<-numEdges(origgraph) subNumEdges<-numEdges(subgraph) dyads <- (origNumNodes * (origNumNodes - 1) / 2) - origNumEdges sampledyads <- subNumNodes * (subNumNodes - 1) / 2 prob<-dhyper(subNumEdges,origNumEdges,dyads,sampledyads) prob } ################################################################ # function: # calcSumProb takes two parameters: # g is the original graph from which the subgraph was made # sg is the subgraph made from the original graph # calcSumProb calculates the probability of having greater than or equal # to the number of edges found in the subgraph given that it was made # from origgraph. # The hypergeometric distribution is used to calculate the summed # probability (using the cdf). # # notes: This calculates the upper tail of the hypergeometric # distribution. # # created by: Elizabeth Whalen # last updated: July 22, 2002 ################################################################ calcSumProb <- function(sg, g) { origNumNodes<-length(nodes(g)) #g subNumNodes<-length(nodes(sg)) #gs origNumEdges<-numEdges(g) #L subNumEdges<-numEdges(sg) #Ls dyads <- (origNumNodes * (origNumNodes - 1) / 2) - origNumEdges sampledyads <- subNumNodes * (subNumNodes - 1) / 2 prob<-phyper(subNumEdges,origNumEdges,dyads,sampledyads,lower.tail=FALSE) prob } ################################################################ # function: # mostEdges takes one parameter: # objGraph is the graph object # mostEdges finds the node that has the most edges in the graph. # The index of the node, the node id (ex. affy id, locus # link id, ...), and the number of edges for that node is returned # in a list. # # created by: Elizabeth Whalen # last updated: August 2, 2002 ################################################################ mostEdges<-function(objGraph) { oEdges<-edges(objGraph) lens <- sapply(oEdges, length) mx <- max(lens) return(names(oEdges)[match(mx, lens)]) } ################################################################ # function: # numNoEdges takes one parameter: # objGraph is the graph object # numNoEdges calculates the number of nodes that have an edge list # of NULL (i.e. no edges) and returns an integer representing # the number of NULL edge lists in the graph. # # created by: Elizabeth Whalen # last updated: July 22, 2002 ################################################################ numNoEdges<-function(objGraph) { els <- sapply(edges(objGraph), length) sum(els==0) } ########################################################## ##RG/2003 ########################################################## ##listEdges: list all edges for every pair of nodes in the graph ##so if there N nodes then there are N choose 2 possible entries ##dropNULL=T/F says whether to drop those pairs with no edges listEdges <- function(object, dropNULL=TRUE) { if( !is(object, "graphNEL") ) stop("'listEdges' only works for graphNEL objects") Nd <- nodes(object) Nn <- length(Nd) EL <- object@edgeL eList <- NULL for(i in seq_len(Nn)) { Node <- Nd[i] ELi <- EL[[i]] for( j in seq(along=ELi$edges) ) { toN <- Nd[ELi$edges[j]] btwn <- paste(sort(c(Node, toN)), collapse=":") newN <-new("simpleEdge", bNode=Node, eNode=toN, weight=if( is.null(ELi$weights[j])) 1 else ELi$weights[j] , directed = edgemode(object)=="directed", edgeType=if(is.null(ELi$type[j])) "" else ELi$type[j]) if( is.null(eList[[btwn]]) ) eList[[btwn]] <- list(newN) else eList[[btwn]] <- list(eList[[btwn]], newN ) } } return(eList) } listLen <- function(list) { stopifnot(is(list, "list")) .Call(graph_listLen, list) } graph/R/attrData.R0000644000175000017500000001110714136046755013610 0ustar nileshnileshsetMethod("initialize", signature("attrData"), function(.Object, defaults) { .Object@data <- list() if (missing(defaults)) defaults <- list() else { if (is.null(names(defaults)) || any(is.na(names(defaults)))) stop("defaults must have names for all elements") } .Object@defaults <- defaults .Object }) .addDefaultAttrs <- function(attrData, defaults) { if (is.null(attrData)) return(defaults) defaults[names(attrData)] <- attrData defaults } .verifyAttrListNames <- function(attrData, defaults) { if (any(! names(attrData) %in% names(defaults))) { nms <- names(attrData) badNms <- nms[! nms %in% names(defaults)] stop("attribute names not in attrData: ", pasteq(badNms)) } else { TRUE } } .checkAttrLength <- function(attrName) { if (length(attrName) != 1) stop("'attr' argument must specify a single attribute name") } .verifyAttrName <- function(attrName, knownNames) { .checkAttrLength(attrName) if (! attrName %in% knownNames) stop("unknown attribute name: ", sQuote(attrName)) TRUE } setMethod("attrDefaults", signature(self="attrData", attr="missing"), function(self, attr) { self@defaults }) setMethod("attrDefaults", signature(self="attrData", attr="character"), function(self, attr) { .verifyAttrName(attr, names(self@defaults)) self@defaults[[attr]] }) setReplaceMethod("attrDefaults", signature(self="attrData", attr="character", value="ANY"), function(self, attr, value) { .checkAttrLength(attr) self@defaults[[attr]] <- value self }) setReplaceMethod("attrDefaults", signature(self="attrData", attr="missing", value="list"), function(self, attr, value) { if (is.null(names(value))) stop("attribute list must have names") self@defaults <- value self }) setMethod("attrDataItem", signature(self="attrData", x="character", attr="missing"), function(self, x, attr) { itemData <- self@data[x] ## unknown items will have name NA and value NULL names(itemData) <- x itemData <- lapply(itemData, .addDefaultAttrs, self@defaults) itemData }) setMethod("attrDataItem", signature(self="attrData", x="character", attr="character"), function(self, x, attr) { .verifyAttrName(attr, names(self@defaults)) .Call(graph_attrData_lookup, self, x, attr) }) setReplaceMethod("attrDataItem", signature(self="attrData", x="character", attr="character", value="ANY"), function(self, x, attr, value) { .verifyAttrName(attr, names(self@defaults)) if (length(value) > 1 && length(value) != length(x)) stop("'value' must be length one or ", "have the same length as 'x'") self@data <- .Call(graph_sublist_assign, self@data, x, attr, value) self }) setReplaceMethod("removeAttrDataItem", signature(self="attrData", x="character", value="NULL"), function(self, x, value) { idx <- match(x, names(self@data)) idx <- idx[!is.na(idx)] if (length(idx)) self@data <- self@data[-idx] self }) setMethod("names", "attrData", function(x) { names(x@data) }) setReplaceMethod("names", signature(x="attrData", value="character"), function(x, value) { if (length(x@data) != length(value)) stop("'value' length doesn't match data") if (any(duplicated(value))) stop("'value' must specify unique names") if (any(is.na(value))) stop("'value' cannot contain NAs") names(x@data) <- value x }) graph/R/graphfunctions.R0000644000175000017500000002166114136046755015104 0ustar nileshnilesh################################################################ # function: # boundary takes two parameters: # graph is the original graph from which the subgraph will be created # subgraph either the subgraph or the nodes of the subgraph # boundary returns a list of length equal to the number of nodes in the # subgraph. Each element is a list of the nodes in graph # # created by: Elizabeth Whalen # last updated: Feb 15, 2003, RG ################################################################ boundary<-function(subgraph, graph) { if ( !is(graph, "graph") ) stop("'graph' must be an object of type graph") if( is(subgraph, "graph") ) snodes <- nodes(subgraph) else if( is.character(subgraph) ) snodes <- subgraph else stop("'subgraph' type incorrect") if( any( !(snodes %in% nodes(graph)) ) ) stop("some nodes not in graph") subE <- inEdges(graph)[snodes] lapply(subE, function(x) x[!(x %in% snodes)] ) } ##check to see if any edges are duplicated, as we often don't have ##good ways to deal with that duplicatedEdges <- function(graph) { if( !is(graph, "graphNEL") ) stop("only graphNEL supported") for(e in graph@edgeL) if( any(duplicated(e$edges)) ) return(TRUE) return(FALSE) } ugraphOld <- function() { .Defunct("ugraph") } setMethod("ugraph", "graph", function(graph) { if (!isDirected(graph)) return(graph) eMat <- edgeMatrix(graph) ## add recip edges eMat <- cbind(eMat, eMat[c(2, 1), ]) ## put into graphNEL edgeL format eL <- lapply(split(as.vector(eMat[2, ]), as.vector(eMat[1, ])), function(x) list(edges=unique(x))) theNodes <- nodes(graph) ## some nodes may be missing names(eL) <- theNodes[as.integer(names(eL))] ## add empty edge list for nodes with no edges noEdgeNodes <- theNodes[!(theNodes %in% names(eL))] noEdges <- lapply(noEdgeNodes, function(x) list(edges=numeric(0))) names(noEdges) <- noEdgeNodes ## FIXME: should we skip standard initialize for speed? ## need to copy over at least the nodeData... graphNEL(nodes=theNodes, edgeL=c(eL, noEdges), edgemode="undirected") }) setMethod("edgeMatrix", c("graphNEL", "ANY"), function(object, duplicates=FALSE) { ## Return a 2 row numeric matrix (from, to, weight) ed <- object@edgeL ##reorder to the same order as nodes ed <- ed[nodes(object)] nN <- length(ed) eds<-lapply(ed, function(x) x$edges) elem <- listLen(eds) from <- rep(seq_len(nN), elem) to <- unlist(eds, use.names=FALSE) ans <- rbind(from, to) ##we duplicate edges in undirected graphNEL ##so here we remove them if( edgemode(object) == "undirected" && !duplicates) { swap <- from>to ans[1,swap]<-to[swap] ans[2,swap]<-from[swap] t1 <- paste(ans[1,], ans[2,], sep="+") ans <- ans[ ,!duplicated(t1), drop=FALSE] } ans }) setMethod("edgeMatrix", c("clusterGraph", "ANY"), function(object, duplicates) { cls<-object@clusters nd <- nodes(object) ans <- numeric(0) for(cl in cls) { idx <- match(cl, nd) nn <- length(idx) v1 <- rep(idx[-nn], (nn-1):1) v2 <- numeric(0) for( i in 2:nn) v2 <- c(v2, i:nn) v2 <- idx[v2] ta <- rbind(v1, v2) if( is.matrix(ans) ) ans <- cbind(ans, rbind(v1, v2)) else ans <- rbind(v1, v2) } dimnames(ans) <- list(c("from", "to"), NULL) ans }) setMethod("edgeMatrix", c("distGraph", "ANY"), function(object, duplicates) { ## Return a 2 row numeric matrix (from, to, weight) ed <- edges(object) ##reorder to the same order as nodes NODES <- nodes(object) ed <- ed[NODES] nN <- length(ed) elem <- listLen(ed) from <- rep(seq_len(nN), elem) to <- match(unlist(ed), NODES) ans <- rbind(from, to) ##we duplicate edges in undirected graphNEL ##so here we remove them ##FIXME: see graphNEL for a speedup of this part if( edgemode(object) == "undirected" && !duplicates) { t1 <- apply(ans, 2, function(x) {paste(sort(x), collapse="+")}) ans <- ans[ ,!duplicated(t1), drop=FALSE] } ans }) setMethod("edgeMatrix", "graphAM", function(object, duplicates=FALSE) { to <- apply(object@adjMat, 1, function(x) which(x != 0), simplify=FALSE) # list stopifnot(is(to, "list")) from <- rep(seq_len(numNodes(object)), listLen(to)) to <- unlist(to, use.names=FALSE) ans <- rbind(from=from, to=to) ## we duplicate edges in undirected graphs ## so here we remove them if (!isDirected(object) && !duplicates) { swap <- from > to ans[1, swap] <- to[swap] ans[2, swap] <- from[swap] t1 <- paste(ans[1, ], ans[2, ], sep="+") ans <- ans[ , !duplicated(t1), drop=FALSE] } ans }) ##it seems to me that we might want the edge weights for ##a given edgeMatrix and that that would be much better done ##in the edgeMatrix function ##we are presuming that eM has integer offsets in it ##eWV <- function(g, eM, sep=ifelse(edgemode(g)=="directed", "->", ## "--")) ##{ ## unE <- unique(eM[1,]) ## edL <- g@edgeL ## eE <- lapply(edL, function(x) x$edges) ## eW <- lapply(edL, function(x) { ## ans = x$weights ## ed = length(x$edges) ## if( is.null(ans) && ed > 0 ) ## ans = rep(1, ed) ## ans}) ## ## nr <- listLen(eE) ## ##now we can subset - ## eMn <- paste(rep((1:length(nr))[unE],nr[unE]), unlist(eE[unE]), sep=sep) ## eWv <- unlist(eW[unE]) ## dE <- paste(eM[1,], eM[2,], sep=sep) ## wh<-match(dE, eMn) ## if(any(is.na(wh)) ) ## stop("edges in supplied edgematrix not found") ## ans <-eWv[wh] ## names(ans) <- eMn[wh] ## ans ##} #eWV <- function(g, eM, sep=ifelse(edgemode(g)=="directed", "->", # "--")) #{ # edL <- g@edgeL # ##fix up the edgeweights so we really find them # eW <- lapply(edL, function(x) { # ans = x$weights # ed = length(x$edges) # if( is.null(ans) && ed > 0 ) # ans = rep(1, ed) # if( length(ans) > 0 ) # names(ans) = x$edges # ans}) # # a1 <- apply(eM, 2, # function(x) eW[[x[1]]][as.character(x[2])]) # names(a1) <- paste(eM[1,], eM[2,], sep=sep) # return(a1) #} eWV <- function (g, eM, sep = ifelse(edgemode(g) == "directed", "->", "--"), useNNames = FALSE) { # returns vector of weights. default has names equal to node # indices, but useNNames can be set to put node names as names # of corresponding weights # n <- nodes(g) from <- n[eM["from", ]] to <- n[eM["to", ]] eW <- tryCatch(edgeData(g, from=from, to=to, attr="weight"), error=function(e) { edgeDataDefaults(g, "weight") <- 1L edgeData(g, from=from, to=to, attr="weight") }) eW <- unlist(eW) if (!useNNames) nms <- paste(eM["from", ], eM["to", ], sep=sep) else nms <- paste(from, to, sep=sep) names(eW) <- nms eW } pathWeights <- function (g, p, eM = NULL) { # # a path is a vector of names of adjacent nodes # we form the vector of steps through the path # (pairs of adjacent nodes) and attach the weights # for each step. no checking is done to verify # that the path p exists in g # if (length(p) < 2) stop("'p' has length < 2") if (is.null(eM)) eM <- edgeMatrix(g) wv <- eWV(g, eM, useNNames = TRUE) sep <- ifelse(edgemode(g) == "undirected", "--", "->") pcomps <- cbind(p[-length(p)], p[-1]) if (edgemode(g) == "undirected") pcomps <- rbind(pcomps, pcomps[,c(2,1)]) # don't know node order in wv labels inds <- apply(pcomps, 1, function(x) paste(x[1], x[2], sep = sep)) tmp <- wv[inds] tmp[!is.na(tmp)] } graph/R/gxlReader.R0000644000175000017500000002353114136046755013765 0ustar nileshnileshgraphNELhandler <- function () { ## ## this function is to work with omegahat's XML xmlEventParse ## current version: given a GXL graph, capture the node names and ## edge data to return the graph as graph::graphNEL ## graphID <- NULL curNode <- NULL curEdge <- NULL curAttr <- NULL inNode <- FALSE inEdge <- FALSE inAttr <- FALSE inInt <- FALSE inFloat <- FALSE inBool <- FALSE g <- graphNEL() nodeL <- list() edgeL <- list() edgemode <- NULL ## ## handler elements: start elements are cased for ## graph, node, attr, or edge ## text is limited in the simple example to the attr tag, ## which lives under a node or an edge ## startElement <- function(x, atts, ...) { if (x == "graph") { graphID <<- atts["id"] eMode <- atts["edgemode"] if (!is.na(eMode)) { if (eMode %in% c("undirected", "defaultundirected")) edgemode(g) <<- "undirected" else edgemode(g) <<- "directed" ## not sure we'll need this } else { ## default is directed for GXL edgemode(g) <<- "directed" } edgemode <<- atts["edgemode"] } else if (x == "node") { inNode <<- TRUE theNode <- as.character(atts["id"]) if (! (theNode %in% nodes(g))) g <<- addNode(theNode, g) nodeL[[theNode]] <<- list() curNode <<- theNode } else if (x == "attr") { inAttr <<- TRUE curAttr <<- atts["name"] } else if (x == "edge") { inNode <<- FALSE inEdge <<- TRUE from <- as.character(atts["from"]) to <- as.character(atts["to"]) if (!(from %in% nodes(g))) g <<- addNode(from, g) if (!(to %in% nodes(g))) g <<- addNode(to, g) g <<- addEdge(from=from, to=to, g) edgeL[[atts["id"]]] <<- list() edgeL[[atts["id"]]][["span"]] <<- c(from, to) curEdge <<- list(from=from, to=to) } else if (x == "int") { inInt <<- TRUE } else if (x == "float") { inFloat <<- TRUE } else if (x == "bool") { inBool <<- TRUE } } text <- function(x, atts, ...) { if (inAttr && nchar(x) > 0) { if (inInt) x <- as.integer(x) if (inFloat) x <- as.double(x) if (inBool) { if (identical(x, "true")) x <- TRUE else if (identical(x, "false")) x <- FALSE else stop("bad bool value: ", x) } if (inNode) { if (!(curAttr %in% nodeDataDefaults(g))) nodeDataDefaults(g, curAttr) <<- NA nodeData(g, curNode, curAttr) <<- x } else if (inEdge) { if (!(curAttr %in% edgeDataDefaults(g))) edgeDataDefaults(g, curAttr) <<- NA edgeData(g, from=curEdge$from, to=curEdge$to, curAttr) <<- x } } } endElement <- function(x, ...) { if (x == "attr") inAttr <<- FALSE else if (x == "node") inNode <<- FALSE else if (x == "edge") inEdge <<- FALSE else if (x == "int") inInt <<- FALSE else if (x == "float") inFloat <<- FALSE else if (x == "bool") inBool <<- FALSE } dump <- function() { list(graphID = graphID, nodeL = nodeL, edgeL = edgeL, edgemode = edgemode) } asGraphNEL <- function() { if (!validGraph(g)) { msg <- "GXL did not define a valid graph package graphNEL object. Most likely there is a failure of reciprocity for edges in an undirected graph. If there is a node for edge from A to B in an undirected graphNEL, there must also be an edge from B to A." stop(paste0(c("", strwrap(msg)), collapse="\n")) } return(g) } list(startElement = startElement, endElement = endElement, text = text, dump = dump, asGraphNEL = asGraphNEL) } graph_handler <- function () { ## ## this function is to work with omegahat's XML xmlEventParse ## current version: given a GXL graph, capture the node names and ## edge data to return the graph as graph::graphNEL ## all_nodes_e <- new.env(parent=emptyenv(), hash=TRUE) node_data_e <- new.env(parent=emptyenv(), hash=TRUE) node_defaults_e <- new.env(parent=emptyenv(), hash=TRUE) edge_data_e <- new.env(parent=emptyenv(), hash=TRUE) edge_defaults_e <- new.env(parent=emptyenv(), hash=TRUE) from_e <- new.env(parent=emptyenv(), hash=TRUE) to_e <- new.env(parent=emptyenv(), hash=TRUE) nodeCount <- 0L edgeCount <- 0L graphID <- NULL curNode <- NULL curAttr <- NULL inNode <- FALSE inEdge <- FALSE inAttr <- FALSE inInt <- FALSE inFloat <- FALSE inBool <- FALSE edgemode <- NULL add_node <- function(theNode) { if (!exists(theNode, all_nodes_e)) { nodeCount <<- nodeCount + 1L all_nodes_e[[theNode]] <- nodeCount } } add_edge <- function(from, to) { edgeCount <<- edgeCount + 1L ## FIXME: check for dup edge? k <- as.character(edgeCount) from_e[[k]] <- from to_e[[k]] <- to } ## ## handler elements: start elements are cased for ## graph, node, attr, or edge ## text is limited in the simple example to the attr tag, ## which lives under a node or an edge ## startElement <- function(x, atts, ...) { if (x == "graph") { if (!is.null(graphID)) stop("multiple graphs not supported") graphID <<- atts["id"] eMode <- atts["edgemode"] if (!is.na(eMode)) { if (eMode %in% c("undirected", "defaultundirected")) edgemode <<- "undirected" else edgemode <<- "directed" ## not sure we'll need this } else { ## default is directed for GXL edgemode <<- "directed" } } else if (x == "node") { inNode <<- TRUE theNode <- as.character(atts["id"]) add_node(theNode) curNode <<- theNode } else if (x == "attr") { inAttr <<- TRUE curAttr <<- atts["name"] } else if (x == "edge") { inNode <<- FALSE inEdge <<- TRUE from <- as.character(atts["from"]) to <- as.character(atts["to"]) add_node(from) add_node(to) add_edge(from, to) } else if (x == "int") { inInt <<- TRUE } else if (x == "float") { inFloat <<- TRUE } else if (x == "bool") { inBool <<- TRUE } } text <- function(x, atts, ...) { if (inAttr && nchar(x) > 0) { if (inInt) x <- as.integer(x) if (inFloat) x <- as.double(x) if (inBool) { if (identical(x, "true")) x <- TRUE else if (identical(x, "false")) x <- FALSE else stop("bad bool value: ", x) } if (inNode) { node_defaults_e[[curAttr]] <- as.character(NA) nattrs <- node_data_e[[curNode]] if (!length(nattrs)) nattrs <- list() nattrs[[curAttr]] <- x node_data_e[[curNode]] <- nattrs } else if (inEdge) { edge_defaults_e[[curAttr]] <- as.character(NA) k <- as.character(edgeCount) eattrs <- edge_data_e[[k]] if (!length(eattrs)) eattrs <- list() eattrs[[curAttr]] <- x edge_data_e[[k]] <- eattrs } } } endElement <- function(x, ...) { if (x == "attr") inAttr <<- FALSE else if (x == "node") inNode <<- FALSE else if (x == "edge") inEdge <<- FALSE else if (x == "int") inInt <<- FALSE else if (x == "float") inFloat <<- FALSE else if (x == "bool") inBool <<- FALSE } asGraphNEL <- function() { ftmat <- cbind(from=unlist(as.list(from_e)), to=unlist(as.list(to_e))) ## could call ftM2graphNEL here, but building up the object this ## way may be better... as we add the edges last. Note that ## ftM2graphNEL is much pickier about duplicated edges for ## undirected graphs, so we would need to filter those for the ## undirected case. nn <- unlist(as.list(all_nodes_e)) # retain original node order nn <- names(nn)[order(nn)] g <- graphNEL(nodes=nn, edgemode=edgemode) if (length(node_defaults_e)) { nd <- new("attrData", as.list(node_defaults_e)) nd@data <- as.list(node_data_e) g@nodeData <- nd } if (length(edge_data_e)) { ed <- new("attrData", as.list(edge_defaults_e)) edvals <- as.list(edge_data_e) names(edvals) <- .makeEdgeKeys(ftmat[, 1], ftmat[, 2]) ed@data <- edvals g@edgeData <- ed } g <- addEdge(ftmat[, 1], ftmat[, 2], g) validObject(g) g } list(startElement = startElement, endElement = endElement, text = text, asGraphNEL = asGraphNEL) } graph/R/buildDepGraph.R0000644000175000017500000000025714136046755014562 0ustar nileshnileshpkgInstOrder <- function() { .Defunct("getInstallOrder", package="pkgDepTools") } buildRepDepGraph <- function() { .Defunct("makeDepGraph", package="pkgDepTools") } graph/R/graph-constructors.R0000644000175000017500000000102314136046755015707 0ustar nileshnilesh# constructors for two subclasses of graph: graphNEL, graphAM # graphNEL <- function (nodes=character(), edgeL=list(), edgemode='undirected') { new("graphNEL", nodes=nodes, edgeL=edgeL, edgemode=edgemode) } graphAM <- function (adjMat=matrix(integer(), 0, 0), edgemode='undirected', values=NA) { if (length (values) == 1L && is.na (values)) new("graphAM", adjMat=adjMat, edgemode=edgemode) else new("graphAM", adjMat=adjMat, edgemode=edgemode, values=values) } graph/R/settings.R0000644000175000017500000001542714136046755013715 0ustar nileshnilesh## change or return the current defaults for a graph's rendering information graph.par <- function(...) { new <- list(...) if (is.null(names(new)) && length(new) == 1 && is.list(new[[1]])) new <- new[[1]] old <- .GraphEnv$par ## if no args supplied, returns full par list if (length(new) == 0) return(old) ## typically getting par nm <- names(new) if (is.null(nm)) return(old[unlist(new)]) ## setting at least one par, but may get some as well (unlikely in practice) isNamed <- nm != "" if (any(!isNamed)) nm[!isNamed] <- unlist(new[!isNamed]) ## so now everything has non-"" names, but only the isNamed ones ## should be set. Everything should be returned though. retVal <- old[nm] names(retVal) <- nm nm <- nm[isNamed] .GraphEnv$par <- modifyList(old, new[nm]) invisible(retVal) } ## get a particular graph rendering parameter set. Valid sets are "nodes", ## "edges" and "graph" graph.par.get <- function(name) .GraphEnv$par[[name]] ## need NULL or empty string for everything that should not be set to ## allow for resetting (like labels and title) .default.graph.pars <- function() list(nodes = list(col = "black", fill = "transparent", textCol = "black", fontsize=14, lty = 1, lwd = 1, label=NULL, fixedsize=FALSE, shape="circle", iwidth=0.75, iheight=0.5), edges = list(col = "black", lty = 1, lwd = 1, textCol = "black", cex = 1, fontsize=14), graph = list(laidout=FALSE, recipEdges="combined", main="", sub="", cex.main=1.2, cex.sub=1, label=NULL, col.main="black", col.sub="black")) ## create a renderInfo object .renderInfoPrototype <- new("renderInfo") ## FIXME: make these generic? ## return node-specific rendering parameters nodeRenderInfo <- function(g, name) { if(missing(name)) g@renderInfo@nodes else{ tmp <- g@renderInfo@nodes[name] if(length(tmp)==1) tmp <- tmp[[1]] tmp } } ## return edge-specific rendering parameters edgeRenderInfo <- function(g, name) { if(missing(name)) g@renderInfo@edges else{ tmp <- g@renderInfo@edges[name] if(length(tmp)==1) tmp <- tmp[[1]] tmp } } ## return graph-specific rendering parameters graphRenderInfo <- function(g, name) { if(missing(name)) g@renderInfo@graph else{ tmp <- g@renderInfo@graph[name] if(length(tmp)==1) tmp <- tmp[[1]] tmp } } ## return content of the pars slot parRenderInfo <- function(g, name) { if(missing(name)) g@renderInfo@pars else g@renderInfo@pars[[name]] } ## changes renderInfo settings of a graph g setRenderInfo <- function(g, what, value, validNames, n = length(validNames)) { ## FIXME: what's supposed to happen if graph is not already laid out? if (!is.list(value) || is.null(names(value)) || any(!nzchar(names(value)))) stop("'value' must be a list of named parameters") for (i in names(value)) { thisVal <- value[[i]] if (is.null(slot(g@renderInfo, what)[[i]])) { ## i doesn't exist. Need to create appropriate placeholder m <- if(is.null(thisVal)) "character" else mode(thisVal) slot(g@renderInfo, what)[[i]] <- vector(mode=m, length = n) ## initialize to NA (seems to work for lists too, but may ## need methods for non-trivial objects) is.na(slot(g@renderInfo, what)[[i]]) <- TRUE names(slot(g@renderInfo, what)[[i]]) <- validNames } ## Now replace relevant parts if (length(thisVal) <= 1 && is.null(names(thisVal))) { ## change everything or revert to default if value is NULL repl <- if(is.null(thisVal)) graph.par()[[what]][[i]] else thisVal if(is.null(repl)){ slot(g@renderInfo, what)[[i]] <- repl }else{ for(j in seq_along(slot(g@renderInfo, what)[[i]])) slot(g@renderInfo, what)[[i]][[j]] <- repl } } else { ## change only named values ## FIXME: check for all(names(thisVal) %in% nms) ? repNames <- intersect(names(thisVal), validNames) null <- sapply(thisVal, is.null) if(any(!null)) slot(g@renderInfo, what)[[i]][repNames][!null] <- thisVal[intersect(repNames, names(which(!null)))] if(any(null)) slot(g@renderInfo, what)[[i]][intersect(repNames, names(which(null)))] <- graph.par()[[what]][[i]] } } g } ## setter for node render parameters "nodeRenderInfo<-" <- function(g, value) { suppressWarnings(setRenderInfo(g, what = "nodes", value = value, validNames = nodes(g))) } ## swap tail and head in edge names swapNames <- function(names){ if(!is.null(names)){ ns <- strsplit(names, "~") sapply(ns, function(x) paste(x[2], x[1], sep="~")) } } ## setter for edge render parameters "edgeRenderInfo<-" <- function(g, value) { ## edge tail and head order doesn't matter for undirected graphs ## so we simply duplicate the settings and swap tails and heads ## in the duplicate's names if(!isDirected(g)){ value <- lapply(value, function(x){ y <- x if(length(x)>1 && !is.null(names(x))){ y <- rep(x,2) names(y) <- c(names(x), swapNames(names(x))) } y }) } suppressWarnings(setRenderInfo(g, what = "edges", value = value, validNames=edgeNames(g, recipEdges=graphRenderInfo(g, "recipEdges")))) } ## setter for graph render parameters "graphRenderInfo<-" <- function(g, value) { ## value may be a arbitrary list if (!is.list(value)) stop("'value' must be a list") g@renderInfo@graph <- suppressWarnings(modifyList(g@renderInfo@graph, value)) g } ## setter for the pars slot "parRenderInfo<-" <- function(g, value) { ## value may be a list with components nodes, edges (like graph.pars()) if (!is.list(value) || !all(names(value) %in% c("nodes", "edges", "graph"))) stop("'value' must be a list, with possible components named ", "'nodes', 'edges' and 'graph'") if (any(unlist(lapply(value, function(x) sapply(x, length))) > 1)) stop("all components of 'value$nodes', 'value$edges' and ", "'value$graph' must have length 1") g@renderInfo@pars <- suppressWarnings(modifyList(g@renderInfo@pars, value)) g } graph/R/methods-graphBAM.R0000644000175000017500000017143614136046755015142 0ustar nileshnilesh## bit array adjacency matrix representation of a graph setMethod("initialize", signature("graphBAM"), function(.Object, nodes,edgeSet) { .Object@graphData$edgemode <- if (isDirected(edgeSet)) "directed" else "undirected" .Object@renderInfo@edges <- list(arrowhead=NULL, arrowtail=NULL) .Object@nodeData <- new("attrData") .Object@edgeData <- new("attrData") .Object@nodes <- nodes .Object@edgeSet <- edgeSet .Object }) graphBAM <- function(df, nodes = NULL, edgemode = "undirected", ignore_dup_edges = FALSE) { .required <- c("from", "to", "weight") cl <- .required %in% names(df) if (!all(cl)) { stop("required 'names(df)' not present: ", pasteq(.required[!cl])) } if (any(duplicated(nodes))) stop(sQuote(nodes), " must be unique") edge_nodes <- unique(c(as.character(df$from), as.character(df$to))) if (!all(edge_nodes %in% nodes)) nodes <- sort(c(edge_nodes, nodes)) else if (is.null(nodes)) nodes <- edge_nodes is_directed <- edgemode == "directed" edge_sets <- .makeMDEdgeSet(es_name = 1, es = df, is_directed = is_directed, nodes, ignore_dup_edges = ignore_dup_edges) g <- new("graphBAM", nodes = nodes, edgeSet = edge_sets) g@edgeData@defaults[["weight"]] <- 1L g } setMethod("numEdges", signature = signature(object = "graphBAM"), function(object) { numEdges(object@edgeSet) }) .undirectEdges <- function(from, to) { fromIsFirst <- from <= to toIsFirst <- !fromIsFirst tmpFrom <- c(from[fromIsFirst], to[toIsFirst]) tmpTo <- c(to[fromIsFirst], from[toIsFirst]) from <- tmpFrom to <- tmpTo list(from=from, to=to) } .edges_gbam <- function(object, which, direction="out") { nn <- nodes(object) if (numEdges(object) == 0L) { names(nn) <- nn c0 <- character(0L) return(lapply(nn, function(x) c0)) } ft <- .Call(graph_bitarray_rowColPos, object@edgeSet@bit_vector) ft[] <- nn[ft] eL <- singles <- NULL if (isDirected(object)) { if (direction == "in") ft[ , c("from", "to")] <- ft[ , c("to", "from")] eL <- split(ft[ , "to"], ft[ , "from"]) singles <- nn[!(nn %in% ft[ , "from"])] } else { eL <- lapply(split(ft, ft[ , c("to", "from")]), unique) singles <- nn[!(nn %in% ft)] } if (length(singles) > 0) { names(singles) <- singles c0 <- character(0L) empties <- lapply(singles, function(x) c0) eL <- c(eL, empties) } eL[order(names(eL))] } setMethod("inEdges", signature("character", "graphBAM"), function(node, object) { .edges_gbam(object, direction = "in")[node] }) setMethod("edges", signature("graphBAM"), function(object, which, direction="out") { if (missing(which)) return(.edges_gbam(object, which, direction)) if (!missing(direction)) warning("'direction' is ignored when 'which' is specified") ## TODO: refactor to optimize .edges_gbam(object)[which] }) setMethod("adj", c("graphBAM", "character"), function(object, index) edges(object, index)) getWeightList2 <- function(g){ nodeNames <- g@nodes numNodes <- length(nodeNames) w <- g@edgeSet@weights ft <- .Call(graph_bitarray_rowColPos, g@edgeSet@bit_vector) if(!isDirected(g)){ ft <- rbind(ft, ft[ , c(2L, 1L)]) w <- c(w,w) } ft[] <- nodeNames[ft] wList <- split(w, ft[ , 1L]) wNameList <- split(ft[ , 2L], ft[ , 1L]) wList <- mapply(function(wVals, wNames) { names(wVals) <- wNames a <- wVals[order(wNames)] if (!isDirected(g)) a[!duplicated(names(a))] else a }, wList, wNameList, SIMPLIFY=FALSE) haveNoEdge <- setdiff(nodeNames, names(wList)) names(haveNoEdge) <- haveNoEdge n0 <- numeric(0) haveNoEdge <- lapply(haveNoEdge, function(x) n0) c(wList, haveNoEdge)[nodeNames] } setMethod("edgeWeights", signature(object="graphBAM", index="character"), function(object, index, attr, default, type.checker) { if (!is.character(attr) || length(attr) != 1) stop("'attr' must be character(1)") if (!is.null(type.checker) && !is.function(type.checker)) stop("'type.checker' must be a function or NULL") getWeightList2(object)[index] }) setMethod("edgeWeights", signature(object="graphBAM", index="numeric"), function(object, index, attr, default, type.checker) { edgeWeights(object, nodes(object)[index], attr=attr, default=default, type.checker=type.checker) }) setMethod("edgeWeights", signature(object="graphBAM", index="missing"), function(object, index, attr, default, type.checker) { edgeWeights(object, nodes(object), attr=attr, default=default, type.checker=type.checker) }) .eAttrsFun <- function(self, from, attr) { nodeNames <- self@nodes indx <- which(nodeNames %in% from) numNodes <- length(nodeNames) bv <- self@edgeSet@bit_vector .verifyBAMAttrs(self, attr) val <- .retAttrVec(self, attr) ft <- .Call(graph_bitarray_rowColPos, bv) if(!isDirected(self)){ df <- cbind(from=ft[,"to"], to = ft[,"from"]) ft <- rbind(ft,df) val <- c(val,val) } tmp <- seq_len(length(val)) # indices into val ft <- data.frame(ft, tmp, stringsAsFactors = FALSE ) ft <- ft[ ft[,"from"] %in% indx,] if(nrow(ft) == 0) stop("edges specified in 'from' not found in 'self'") nodeLbl <- paste( nodeNames[ft[,"from"]], nodeNames[ft[, "to"]], sep ="|") val <- val[ft[,"tmp"]][seq_along(nodeLbl)] names(val) <- nodeLbl val } ## graphBAM edgeData methods setMethod("edgeData", signature(self="graphBAM", from="character", to= "missing", attr="character"), function(self, from, to, attr){ as.list(.eAttrsFun(self, from, attr)) }) setMethod("edgeData", signature(self="graphBAM", from="character", to="character", attr="character"), function(self, from, to, attr) { edgeData.from <- edgeData(self, attr=attr, from=from) unrecognized.nodes <- setdiff(to, nodes(self)) if(length(unrecognized.nodes) > 0) { msg <- sprintf("nodes not in graph: %s", paste(sQuote(unrecognized.nodes), collapse=", ")) stop(msg) } edgeNames <- names(edgeData.from) toStarts <- regexpr("|", edgeNames, fixed=TRUE) + 1L actual.to.nodes <- substring(edgeNames, toStarts, nchar(edgeNames)) edgeData.from[actual.to.nodes %in% to] }) setMethod("edgeData", signature(self="graphBAM", from="missing", to= "character", attr="character"), function(self, from, to, attr){ nodeNames <- self@nodes numNodes <- length(nodeNames) bv <- self@edgeSet@bit_vector .verifyBAMAttrs(self, attr) val <- .retAttrVec(self, attr) ft <- .Call(graph_bitarray_rowColPos, self@edgeSet@bit_vector) if(!isDirected(self)){ df <- cbind(from=ft[,"to"], to = ft[,"from"]) ft <- rbind(ft,df) val <- c(val,val) } tmp <- seq_len(length(val)) ft <- data.frame(ft, tmp, stringsAsFactors = FALSE) ft <- ft[ft[,"to"] %in% which(nodeNames %in% to),] if(nrow(ft) == 0) stop("edges specified in 'to' not found in 'self'") .verifyEdges(self, nodeNames[ft[,"from"]], nodeNames[ft[,"to"]]) nodeLbl <- paste( nodeNames[ft[,"from"]], nodeNames[ft[, "to"]], sep ="|") val <- val[ft[,"tmp"]][seq_along(nodeLbl)] names(val) <- nodeLbl as.list(val) }) setMethod("edgeData", signature(self="graphBAM", from="missing", to="missing", attr="missing"), function(self, from, to, attr) { nodeNames <- self@nodes numNodes <- length(nodeNames) attr <- "weight" bv <- self@edgeSet@bit_vector ft <- .Call(graph_bitarray_rowColPos, bv) w <- .retAttrVec(self, attr) if(!isDirected(self)){ df <- cbind(from=ft[,"to"], to = ft[,"from"]) ft <- rbind(ft,df) w <- c(w,w) } nodeLbl <- paste( nodeNames[ft[,"from"]], nodeNames[ft[, "to"]], sep ="|") names(w) <- nodeLbl lapply(w, function(x) list(weight = as.numeric(x))) }) setMethod("edgeData", signature(self="graphBAM", from="missing", to= "missing", attr="character"), function(self, from, to, attr){ as.list(.eAttrsFun(self, from = names(edges(self)), attr= attr)) }) .retAttrVec <- function(g, attr) { if(attr !="weight") { k1 <- g@edgeSet@bit_vector k2<- g@userAttrPos@edgePos[[attr]] tmp <- attributes(k1) res <- k1& (!k2) attributes(res) <- tmp ns <- .Call(graph_bitarray_sum, res) attr(res, "nbitset") <- ns ft <- data.frame(.Call(graph_bitarray_rowColPos, res), stringsAsFactors = TRUE) dflt <- g@edgeData@defaults[[attr]] attrBit <- g@userAttrPos@edgePos[[attr]] ft <- ft[with(ft, order(to, from)),] if(nrow(ft)) { ord <- .Call(graph_bitarray_getEdgeAttrOrder, attrBit, as.integer(ft[,"from"]), as.integer(ft[,"to"])) attrBit <- setBitCell(attrBit, ft[,"from"], ft[,"to"], rep(1L, nrow(ft))) nt <- attr(attrBit, "nbitset") } else { nt <- attr(attrBit, "nbitset") ord <- list(newLeftPos = integer(0), newRightPos = integer(0), origLeftPos = seq_len(nt), origRightPos = seq_len(nt)) } newAttr <- vector(nt, mode = mode(dflt)) if(!is.null(g@edgeSet@edge_attrs[[attr]])) { newAttr[ord$origLeftPos] <- g@edgeSet@edge_attrs[[attr]][ord$origRightPos] newAttr[ord$newLeftPos] <- if(mode(dflt)=="list") rep(list(dflt), length(ord$newLeftPos)) else dflt }else{ newAttr[seq_len(nt)] <- if(mode(dflt)=="list") rep(list(dflt), nt) else dflt } }else{ newAttr <- g@edgeSet@weights } newAttr } .align_from_to <- function(from, to, nodeNames) { from_len <- length(from) to_len <- length(to) req_nn <- unique(c(from, to)) if (!all(okidx <- req_nn %in% nodeNames)) stop("unknown nodes: ", pasteq(req_nn[!okidx])) if (from_len != to_len) { if (from_len == 1L) from <- rep(from, to_len) else if (to_len == 1L) to <- rep(to, from_len) else stop("invalid lengths of 'from' and 'to'") } df <- cbind(from=from, to=to) } .verifyBAMAttrs <- function(bam, attr) { if( !(attr %in% names(bam@edgeData@defaults))) stop("'attr' not found: ", sQuote(attr)) } .set_attrs <- function(g, from, to, attr, value) { nodeNames <- g@nodes req_ft <- .align_from_to(from, to, nodeNames) ## remove dups indx <- duplicated(paste(req_ft[,"from"], req_ft[,"to"], sep ="_")) req_ft <- req_ft[!indx, ,drop = FALSE] if(nrow(req_ft) > 0 ) .verifyEdges(g, req_ft[,1], req_ft[,2]) else stop("edges specified could not be found in \"self\"") if(is.vector(value)) { len <- length(value) }else{ len <- 1 value <- list(value) } if(len == 1L) value <- rep(value, nrow(req_ft)) if(length(value) != nrow(req_ft)) stop("number of edges and attribute values must be the same") ft <- .Call(graph_bitarray_rowColPos, g@edgeSet@bit_vector) if (!isDirected(g)) { ## normalize from/to valIndx <- seq_len(length(value)) tmp <- .mg_undirectEdges(req_ft[ , 1], req_ft[, 2], valIndx) req_ft <- cbind("from"= tmp[["from"]],"to" = tmp[["to"]]) value <- value[tmp[["weight"]]] } req_i <- structure(match(req_ft, nodeNames), dim = dim(req_ft)) colnames(req_i) <- c("from", "to") req_i <- data.frame(req_i, stringsAsFactors = TRUE) idx <- order(req_i[,2], req_i[,1]) req_i <- req_i[idx, ] value <- value[idx] if(attr == "weight") { attrBit <- g@edgeSet@bit_vector if(nrow(req_i)) { ord <- .Call(graph_bitarray_getEdgeAttrOrder, attrBit, as.integer(req_i[,"from"]), as.integer(req_i[,"to"])) g@edgeSet@bit_vector <- setBitCell(attrBit, req_i[,"from"], req_i[,"to"], rep(1L, nrow(req_i))) nt <- attr(g@edgeSet@bit_vector, "nbitset") } else { nt <- attr(attrBit, "nbitset") ord <- list(newLeftPos = integer(0), newRightPos = integer(0), origLeftPos = seq_len(nt), origRightPos = seq_len(nt)) } newAttr <- vector(nt, mode = mode(value)) newAttr[ord$origLeftPos] <- g@edgeSet@weights[ord$origRightPos] newAttr[ord$newLeftPos] <- value[ord$newRightPos] g@edgeSet@weights <- newAttr }else { attrBit <- g@userAttrPos@edgePos[[attr]] if(nrow(req_i)) { ord <- .Call(graph_bitarray_getEdgeAttrOrder, attrBit, as.integer(req_i[,"from"]), as.integer(req_i[,"to"])) g@userAttrPos@edgePos[[attr]] <- setBitCell(attrBit, req_i[,"from"], req_i[,"to"], rep(1L, nrow(req_i))) nt <- attr(g@userAttrPos@edgePos[[attr]], "nbitset") } else { nt <- attr(attrBit, "nbitset") ord <- list(newLeftPos = integer(0), newRightPos = integer(0), origLeftPos = seq_len(nt), origRightPos = seq_len(nt)) } newAttr <- vector(nt, mode = mode(value)) newAttr[ord$origLeftPos] <- g@edgeSet@edge_attrs[[attr]][ord$origRightPos] newAttr[ord$newLeftPos] <- value[ord$newRightPos] g@edgeSet@edge_attrs[[attr]] <- newAttr } g } ## graphBAM edgeData replacement methods setReplaceMethod("edgeData", signature(self="graphBAM", from="character", to="character", attr="character", value="ANY"), function(self, from, to, attr, value) { .verifyAttrName(attr, names(self@edgeData@defaults)) lenFrom <- length(from) lenTo <- length(to) if(lenFrom != lenTo) { if(lenFrom ==1) from <- rep(from, lenTo) else if (lenTo == 1) to <- rep(to , lenFrom) else stop("'from', 'to' differ in length") } .verifyEdges(self, from, to) .set_attrs(self, from, to, attr, value) }) setReplaceMethod("edgeData", signature(self="graphBAM", from="character", to="missing", attr="character", value="ANY"), function(self, from, to, attr, value) { .verifyAttrName(attr, names(self@edgeData@defaults)) eg <- edges(self,from) to <- unlist(eg, use.names = FALSE) len <- as.numeric(sapply(eg, length)) from <- rep(names(eg),len) .verifyEdges(self, from, to) .set_attrs(self, from, to, attr, value) }) setReplaceMethod("edgeData", signature(self="graphBAM", from="missing", to="character", attr="character", value="ANY"), function(self, from, to, attr, value) { .verifyAttrName(attr, names(self@edgeData@defaults)) eg <- inEdges(to, self) eg <- eg[order(names(eg))] from <- unlist(eg, use.names = FALSE) len <- as.numeric(sapply(eg, length)) to <- rep(names(eg), len) .verifyEdges(self, from, to) .set_attrs(self, from, to, attr, value) }) ## graphBAM edgeDataDefaults replacement methods setReplaceMethod("edgeDataDefaults", signature(self="graphBAM", attr="missing", value="list"), function(self, attr, value) { attrDefaults(self@edgeData) <- value wt <- self@edgeData@defaults[["weights"]] if(!is.numeric(wt) && !is.null(wt)) stop("'weights' attribute must be numeric()") ndsLen <- length(nodes(self)) nms <- names(value) for(i in seq_along(value)) { if(!(nms[i] %in% names(self@userAttrPos@edgePos))) { if(nms[i] != "weight"){ posBit <- .createZeroBitPos(ndsLen) self@userAttrPos@edgePos[[nms[i]]] <- posBit } } } self }) setReplaceMethod("edgeDataDefaults", signature(self="graphBAM", attr="character", value="ANY"), function(self, attr, value) { attrDefaults(self@edgeData, attr) <- value if(attr == "weight") { wt <- self@edgeData@defaults[["weights"]] if(!is.numeric(wt) && !is.null(wt)) stop("'weights' attribute must be numeric()") } else{ ndsLen <- length(nodes(self)) if(!(attr %in% names(self@userAttrPos@edgePos))) { posBit <- .createZeroBitPos(ndsLen) self@userAttrPos@edgePos[[attr]] <- posBit } } self }) .createZeroBitPos <- function(ndsLen) { makebits(ndsLen * ndsLen, bitdim = c(ndsLen, ndsLen)) } setMethod("numNodes", signature("graphBAM"), function(object) length(object@nodes)) setMethod("isAdjacent", signature(object="graphBAM", from="character", to="character"), function(object, from, to) { if(length(from) > 1 & length(to) == 1) to <- rep(to, length(from)) if(length(to) > 1 & length(from) == 1) from <- rep(from, length(to)) stopifnot(length(from) == length(to)) nodeNames <- object@nodes edge.matrix <- edgeMatrix(object) edge.count <- ncol(edge.matrix) reciprocal.edges <- edgemode(object) == "undirected" result <- rep(FALSE, length(from)) pair.count <- length(from) for(pc in seq_len(pair.count)) { for(ec in seq_len(edge.count)){ from.node <- nodeNames[edge.matrix["from", ec]] to.node <- nodeNames[edge.matrix["to", ec]] if(from.node == from[pc] & to.node == to[pc]){ result[pc] <- TRUE break; } if(reciprocal.edges & to.node == from[pc] & from.node == to[pc]){ result[pc] <- TRUE break; } } # for ec } # for pc result }) # isAdjacent setMethod("subGraph", signature(snodes="character", graph="graphBAM"), function(snodes, graph){ origNodes <- nodes(graph) snodes <- sort(snodes) snodesIdx <- match(snodes, origNodes) if (any(is.na(snodesIdx))) { bad <- snodes[which(is.na(snodesIdx))] stop("'snodes' not in MultiGraph: ", pasteq(bad)) } nms <- names(graph@nodeData@defaults) len <- length(snodes) tmp <- makebits(len) for(i in nms){ indx <- bitToLogical(graph@userAttrPos@nodePos[[i]])[snodesIdx] graph@nodeData@data[[i]] <- .getNodeAttrVec(graph, i)[snodesIdx][indx] graph@userAttrPos@nodePos[[i]] <- setbitv(tmp, which(indx), rep(1L, length(which(indx)))) } graph@nodes <- snodes res <- .Call(graph_bitarray_subGraph, graph@edgeSet@bit_vector, snodesIdx) graph@edgeSet@bit_vector <- res$bitVec graph@edgeSet@weights <- graph@edgeSet@weights[res$setPos] nms <- names(graph@edgeSet@edge_attrs) for(i in nms) { attrBit <- graph@userAttrPos@edgePos[[i]] res <- .Call(graph_bitarray_subGraph, attrBit, snodesIdx) graph@edgeSet@edge_attrs[[i]] <- graph@edgeSet@edge_attrs[[i]][res$setPos] graph@userAttrPos@edgePos[[i]] <- res$bitVec } graph }) setMethod("edgeMatrix", "graphBAM", function(object, duplicates=FALSE) { bitvec <- object@edgeSet@bit_vector nds <- nodes(object) df <- .Call(graph_bitarray_rowColPos, bitvec) if (duplicates) df <- rbind(df, cbind(as.vector(df[, "to"]), as.vector(df[, "from"]))) t(df) }) setMethod("adjacencyMatrix", "graphBAM", function(object) { reciprocal.edges <- edgemode(object) == "undirected"; em <- edgeMatrix(object) nodes <- nodes(object) node.count <- length(nodes) mtx.adj <- matrix(0, nrow=node.count, ncol=node.count, dimnames=list(nodes, nodes)) for(col in 1:ncol(em)){ from <- em["from", col] to <- em["to", col] from.node <- nodes[from] to.node <- nodes[to] mtx.adj[from.node, to.node] <- 1; if(reciprocal.edges) mtx.adj[to.node, from.node] <- 1; } mtx.adj }) setMethod("clearNode", signature(node="character", object="graphBAM"), function(node, object) { stop("operation not supported") }) setMethod("removeNode", signature(node="character", object="graphBAM"), function(node, object) { nn <- nodes(object) if(!all(node %in% nn)) stop("'node' not all in 'object'") df <- extractFromTo(object) indx <- ! ( (as.character(df[,"from"]) %in% node) | (as.character(df[,"to"]) %in% node)) nIndx <- !(nn %in% node) bam <- graphBAM(df[indx,], nodes = nn[nIndx] , edgemode = edgemode(object)) bam@edgeSet@weights <- object@edgeSet@weights[indx] bam@edgeData@defaults <- object@edgeData@defaults bam@nodeData@defaults <- object@nodeData@defaults nms <- names(object@edgeSet@edge_attrs) snodesIdx <- which(nIndx) for(i in nms) { attrBit <- object@userAttrPos@edgePos[[i]] res <- .Call(graph_bitarray_subGraph, attrBit, snodesIdx) bam@edgeSet@edge_attrs[[i]] <- object@edgeSet@edge_attrs[[i]][res$setPos] bam@userAttrPos@edgePos[[i]] <- res$bitVec } nms <- names(object@nodeData@defaults) len <- length(snodesIdx) tmp <- makebits(len) for(i in nms){ leftPos <- which(bitToLogical(object@userAttrPos@nodePos[[i]])[snodesIdx]) rightPos <- which(bitToLogical(object@userAttrPos@nodePos[[i]]))[snodesIdx] bt <- setbitv(tmp, leftPos, rep(1L, length(leftPos))) # k <- .getNodeAttrValues(bt, indx) bam@userAttrPos@nodePos[[i]] <- bt bam@nodeData@data[[i]] <- object@nodeData@data[[i]][rightPos] } bam }) setMethod("extractFromTo", "graphBAM", function(g) { diEdgeSetToDataFrame(g@edgeSet, nodes(g)) }) setAs(from="graphBAM", to="matrix", function(from) { edgeSetToMatrix(nodes(from), from@edgeSet, isDirected(from)) }) setAs(from="graphBAM", to="graphAM", function(from) { am <- graphAM(adjMat = as(from, "matrix"), edgemode = edgemode(from), values = list(weight=1)) am }) setAs(from="graphBAM", to="graphNEL", function(from) { am <- as(from, "graphAM") as(am, "graphNEL") }) graphToBAM <- function(object) { ew <- edgeWeights(object) df_empty <- data.frame(from = character(0), to = character(0), weight = numeric(0), stringsAsFactors = TRUE) df_list <- lapply(names(ew), function(x){ tmp <- ew[[x]] if ((nw <- length(tmp)) > 0) { data.frame(from = rep(x, nw), to = names(tmp), weight = as.numeric(tmp), stringsAsFactors = TRUE) } else df_empty }) df <- do.call(rbind, df_list) nn <- nodes(object) bam <- graphBAM(df, nodes = nn, edgemode = edgemode(object), ignore_dup_edges = TRUE) ## FIXME: graphBAM doesn't really handle edge attributes in the same way ## we can copy data over so it can be copied back, but it won't really ## be accessible in the new graphBAM object. bam } setAs(from="graphNEL", to="graphBAM", function(from) as(as(from, "graphAM"), "graphBAM")) setAs(from="graphAM", to="graphBAM", function(from) graphToBAM(from)) setMethod("ugraph", "graphBAM", function(graph) { graph@graphData$edgemode <- "undirected" graph@renderInfo <- new("renderInfo") graph@edgeSet <- ugraph(graph@edgeSet) graph }) setMethod("addEdge", signature=c("character", "character", "graphBAM", "numeric"), function(from, to, graph, weights) { nn <- nodes(graph) req_ft <- .align_from_to(from, to, nn) req_i <- structure(match(req_ft, nn), dim = dim(req_ft)) if(nrow(req_i)) { ord <- .Call(graph_bitarray_getEdgeAttrOrder, graph@edgeSet@bit_vector, as.integer(req_i[,1]), as.integer(req_i[,2])) graph@edgeSet@bit_vector <- setBitCell(graph@edgeSet@bit_vector, req_i[,1], req_i[,2], rep(1L, nrow(req_i))) nt <- attr(graph@edgeSet@bit_vector, "nbitset") } else { nt <- attr(graph@edgeSet@bit_vector, "nbitset") ord <- list(newLeftPos = integer(0), newRightPos = integer(0), origLeftPos = seq_len(nt), origRightPos = seq_len(nt)) } newAttr <- vector(nt, mode = "numeric") newAttr[ord$origLeftPos] <- graph@edgeSet@weights[ord$origRightPos] newAttr[ord$newLeftPos] <- weights[ord$newRightPos] graph@edgeSet@weights <- newAttr graph@edgeData@defaults <- graph@edgeData@defaults graph@edgeSet@edge_attrs <- graph@edgeSet@edge_attrs graph@userAttrPos@edgePos <- graph@userAttrPos@edgePos graph@nodeData@defaults <- graph@nodeData@defaults graph@nodeData@data <- graph@nodeData@data graph@userAttrPos@nodePos <- graph@userAttrPos@nodePos graph }) setMethod("addEdge", signature=c("character", "character", "graphBAM", "missing"), function(from, to, graph, weights) { w <- rep(1L, max(length(from), length(to))) addEdge(from, to, graph, w) }) setMethod("addNode", signature(node="character", object="graphBAM", edges="missing"), function(node, object) { nds <- sort(unique(c(nodes(object), node))) ndsLen <- length(nds) df <- extractFromTo(object) g <- graphBAM(df, nodes = nds, edgemode = edgemode(object)) nms <- names(object@nodeData@defaults) for(i in nms){ origNds <- nodes(object)[(bitToLogical(object@userAttrPos@nodePos[[i]]))] indx <- match(origNds, nodes(g)) bt <- makebits(ndsLen) bt <- setbitv(bt, indx, rep(1L, length(indx))) g@userAttrPos@nodePos[[i]] <- bt g@nodeData@data[[i]] <- object@nodeData@data[[i]] } g@nodeData@defaults <- object@nodeData@defaults g@edgeSet@edge_attrs <- object@edgeSet@edge_attrs g@edgeData@defaults <- object@edgeData@defaults nms <- names(object@userAttrPos@edgePos) for(i in nms){ ft <- .Call(graph_bitarray_rowColPos,object@userAttrPos@edgePos[[i]]) posBit <- .createZeroBitPos(ndsLen) from.nodes.new <- match(nodes(object)[ft[, 'from']], nodes(g)) to.nodes.new <- match(nodes(object)[ft[, 'to']], nodes(g)) g@userAttrPos@edgePos[[i]] <- setBitCell(posBit, from.nodes.new, to.nodes.new, rep(1L, nrow(ft))) } g }) setReplaceMethod("edgemode", c("graphBAM", "character"), function(object, value) { if (length(value) != 1L) stop("'edgemode' must be length one") if (edgemode(object) == value) return(object) switch(value, "directed" = { ## add reciprocal edges df <- extractFromTo(object) es <- rbind(df, data.frame(from=df$to, to=df$from, weight=df$weight, stringsAsFactors=FALSE)) object <- graphBAM(es, nodes = nodes(object), edgemode = value) }, "undirected" = { object <- ugraph(object) }, stop("'edgemode' must be 'directed' or 'undirected', was ", sQuote(value))) object }) .remEdge <- function(from, to, graph) { lenFrom <- length(from) lenTo <- length(to) if(lenFrom != lenTo) { if(lenFrom ==1) from <- rep(from, lenTo) else if (lenTo == 1) to <- rep(to , lenFrom) else stop("arguments 'from', 'to' differ in length") } .verifyEdges(graph, from, to) nn <- nodes(graph) req_ft <- .align_from_to(from, to, nn) req_from <- match(req_ft[,"from"], nn) req_to <- match(req_ft[,"to"], nn) nms <- names(graph@edgeSet@edge_attrs) if(!is.null(nms)) { for(i in nms){ graph@userAttrPos@edgePos[[i]] <- setBitCell(graph@userAttrPos@edgePos[[i]], req_from, req_to, rep(0L, nrow(req_ft))) if(length(req_from)) { ord <- .Call(graph_bitarray_getEdgeAttrOrder, graph@userAttrPos@edgePos[[i]], as.integer(req_from), as.integer(req_to)) } else { nt <- attr(graph@userAttrPos@edgePos[[i]], "nbitset") ord <- list(newLeftPos = integer(0), newRightPos = integer(0), origLeftPos = seq_len(nt), origRightPos = seq_len(nt)) } graph@edgeSet@edge_attrs[[i]] <- graph@edgeSet@edge_attrs[[i]][ord$origLeftPos] } } obv0 <- graph@edgeSet@bit_vector graph@edgeSet@bit_vector <- setBitCell(graph@edgeSet@bit_vector, match(from, nn), match(to, nn), rep(0L, nrow(req_ft))) nbv0 <- graph@edgeSet@bit_vector ord <- .Call(graph_bitarray_getEdgeAttrOrder, graph@edgeSet@bit_vector , as.integer(req_from), as.integer(req_to)) graph@edgeSet@weights <- graph@edgeSet@weights[ord$origLeftPos] if(edgemode(graph) == "undirected"){ # reverse from/to obv1 <- graph@edgeSet@bit_vector graph@edgeSet@bit_vector <- setBitCell(graph@edgeSet@bit_vector, match(to, nn), match(from, nn), rep(0L, nrow(req_ft))) nbv1 <- graph@edgeSet@bit_vector ord <- .Call(graph_bitarray_getEdgeAttrOrder, graph@edgeSet@bit_vector , as.integer(req_from), as.integer(req_to)) graph@edgeSet@weights <- graph@edgeSet@weights[ord$origLeftPos] } # if undirected graph } setMethod("removeEdge", c("character", "character", "graphBAM"), function(from, to, graph) .remEdge(from, to, graph)) setMethod("removeEdgesByWeight", c("graphBAM"), function(graph, lessThan, greaterThan ){ if(missing(lessThan) && missing(greaterThan)) stop("specify 'lessThan' or 'greaterThan'") if(!missing(lessThan) && !missing(greaterThan)){ indx <- ( graph@edgeSet@weights >= lessThan & graph@edgeSet@weights <= greaterThan) } else if(missing(lessThan)){ indx <- graph@edgeSet@weights <= greaterThan }else if(missing(greaterThan)){ indx <- graph@edgeSet@weights >= lessThan } nn <- nodes(graph) bt <- .Call(graph_bitarray_removeEdges, graph@edgeSet@bit_vector, indx) tempBit <- graph@edgeSet@bit_vector & (bt) attributes(tempBit) <- attributes(graph@edgeSet@bit_vector) attr(tempBit, "nbitset") <- .Call(graph_bitarray_sum, tempBit) ft <- .Call(graph_bitarray_rowColPos, tempBit) tp <- graph@edgeSet@bit_vector & (!bt) attributes(tp) <- attributes(graph@edgeSet@bit_vector) attr(tp, "nbitset") <- .Call(graph_bitarray_sum, tp) ft2 <- .Call(graph_bitarray_rowColPos, tp) graph@edgeSet@weights <- graph@edgeSet@weights[indx] graph@edgeSet@bit_vector <- bt nms <- names(graph@userAttrPos@edgePos) if(!is.null(nms)){ for(i in nms) { graph@userAttrPos@edgePos[[i]] <- setBitCell(graph@userAttrPos@edgePos[[i]], ft2[,"from"], ft2[,"to"], rep(0L, nrow(ft2))) if(nrow(ft2)) { ord <- .Call(graph_bitarray_getEdgeAttrOrder, graph@userAttrPos@edgePos[[i]], as.integer(ft2[,"from"]), as.integer(ft2[, "to"])) } else { nt <- attr(graph@userAttrPos@edgePos[[i]], "nbitset") ord <- list(newLeftPos = integer(0), newRightPos = integer(0), origLeftPos = seq_len(nt), origRightPos = seq_len(nt)) } graph@edgeSet@edge_attrs[[i]] <- graph@edgeSet@edge_attrs[[i]][ord$origLeftPos] } } graph }) setReplaceMethod("nodes", c("graphBAM", "character"), function(object, value) { stop("operation not supported") }) .getUnionWeights <- function(attrType, g1, g2, funList) { len <- length(attrType$from) attr1 <- vector(len, mode = "numeric") attr1[seq_len(len)] <- NA ## from x k <- (as.numeric(attrType$from) ==1) attr1[k] <- g1@edgeSet@weights[attrType$indx1[k]] ## from y k <- (as.numeric(attrType$from) == 2) attr1[k] <- g2@edgeSet@weights[attrType$indx2[k]] ## resolve union k <- (as.numeric(attrType$from) ==0) if(any(k)) { val1 <- g1@edgeSet@weights[attrType$indx1[k]] val2 <- g2@edgeSet@weights[attrType$indx2[k]] if(!is.null(funList) && ("weight" %in% names(funList))) { attr1[k] <- sapply(seq_len(sum(k)), function(p) { return(funList[["weight"]](val1[[p]], val2[[p]])) }) } else if(is.vector(val1) && is.vector(val2)) { eqInd <- sapply(seq_len(length(val1)), function(x){ identical(val1[x], val2[x]) }) pt <- which(eqInd) lp <- length(which(k)) tmp <- vector(lp, mode ="numeric") tmp[seq_len(lp)] <- NA tmp[pt] <- val1[pt] attr1[k] <- tmp } } attr1 } .getNodeAttrVec <- function(g, att) { unlist(nodeData(g, attr = att), use.names = FALSE) } .getUnionAttrs <- function(att, attrType, x , y, funList ) { len <- length(attrType$from) indx <- as.numeric(attrType$from) if(att %in% names(x@edgeSet@edge_attrs)) mds <- mode(x@edgeSet@edge_attrs) else if(att %in% names(y@edgeSet@edge_attrs)) mds <- mode(y@edgeSet@edge_attrs) attr1 <- vector(len , mode = mds) attr1[seq_len(len)] <- NA ## from x k <- (as.numeric(attrType$from) ==1) if(att %in% names(x@edgeSet@edge_attrs)) { xAttr <- .retAttrVec(x, att) attr1[k] <- xAttr[ attrType$indx1[k]] } ## from y k <- (as.numeric(attrType$from) == 2) if(att %in% names(y@edgeSet@edge_attrs)) { yAttr <- .retAttrVec(y, att) attr1[k] <- yAttr[ attrType$indx2[k]] } ## resolve union k <- (as.numeric(attrType$from) ==0) if(any(k)) { if(att %in% names(x@edgeSet@edge_attrs)) val1 <- xAttr[ attrType$indx1[k]] else val1 <- yAttr[ attrType$indx2[k]] if(att %in% names(y@edgeSet@edge_attrs)) val2 <- yAttr[ attrType$indx2[k]] else val2 <- xAttr[ attrType$indx1[k]] if(!is.null(funList) && (att %in% names(funList))) { attr1[k] <- sapply(seq_len(sum(k)), function(p) { return(funList[[att]](val1[[p]], val2[[p]])) }) } else if (is.vector(val1) && is.vector(val2)) { eqInd <- sapply(seq_len(length(val1)), function(x){ identical(val1[x], val2[x]) }) pt <- which(eqInd) lp <- sum(k) tmp <- vector(lp, mode = mds) tmp[seq_len(lp)] <- NA tmp[pt] <- val1[pt] attr1[k] <- tmp } } attr1 } .getEdgeIntersect <- function(e1, e2) { dr1 <- isDirected(e1) dr2 <- isDirected(e1) if(dr1 != dr2) stop("edges should both be directed or undirected") theMode <- if (dr1 && dr2) "directed" else "undirected" e1Attr <- names(e1@edge_attrs) e2Attr <- names(e2@edge_attrs) commonAttr <- intersect(e1Attr, e2Attr) bv <- e1@bit_vector & e2@bit_vector attributes(bv) <- attributes(e1@bit_vector) attr(bv, "nbitset") <- ns <- .Call(graph_bitarray_sum, bv) c0 <- character(0) df <- data.frame(from = c0, to = c0, weight = numeric(0), stringsAsFactors = FALSE) edge_set <- .makeMDEdgeSet(es_name = 1, es = df, is_directed = (theMode == "directed"), nodes = c0, ignore_dup_edges = FALSE) edge_set@bit_vector <- bv edge_set } .getBAMIntersect <- function(g1, g2, edge_set, funList) { nn <- intersect(nodes(g1), nodes(g2)) ans <- new("graphBAM", edgeSet= edge_set, nodes =nn) e1Attr <- names(g1@edgeSet@edge_attrs) e2Attr <- names(g2@edgeSet@edge_attrs) commonAttr <- intersect(e1Attr, e2Attr) attrType <- .Call(graph_bitarray_Intersect_Attrs, edge_set@bit_vector, g1@edgeSet@bit_vector, g2@edgeSet@bit_vector) if(!is.null(funList)) { fIndx <- names(funList) %in% c(commonAttr, "weight") if(!all(fIndx)) stop("attributes in 'funList' not in edge attributes: ", pasteq(names(funList)[fIndx])) } if(length(attrType$from) >0) { edge_set@weights <- .getIntersectAttrs("weight", attrType, g1@edgeSet@weights, g2@edgeSet@weights, funList) } for(i in commonAttr) { ans@userAttrPos@edgePos[[i]] <- edge_set@bit_vector xAttr <- .retAttrVec(g1, i) yAttr <- .retAttrVec(g2, i) if(length(attrType$from) >0) { edge_set@edge_attrs[[i]] <- .getIntersectAttrs(i, attrType, xAttr, yAttr, funList) } } ans@edgeSet <- edge_set ans } .bamIntersect <- function(g1, g2, funList) { e1 <- g1@edgeSet e2 <- g2@edgeSet dr1 <- isDirected(e1) dr2 <- isDirected(e1) if(dr1 != dr2) stop("edges should both be directed or undirected") theMode <- if (dr1 && dr2) "directed" else "undirected" e1Attr <- names(e1@edge_attrs) e2Attr <- names(e2@edge_attrs) commonAttr <- intersect(e1Attr, e2Attr) if(!is.null(funList)) { fIndx <- names(funList) %in% c(commonAttr, "weight") if(!all(fIndx)) stop("attributes in 'funList' not in edge attributes: ", pasteq(names(funList)[fIndx])) } bv <- e1@bit_vector & e2@bit_vector attributes(bv) <- attributes(e1@bit_vector) attr(bv, "nbitset") <- ns <- .Call(graph_bitarray_sum, bv) c0 <- character(0) df <- data.frame(from = c0, to = c0, weight = numeric(0), stringsAsFactors = FALSE) edge_set <- .makeMDEdgeSet(es_name = 1, es = df, is_directed = (theMode == "directed"), nodes = c0, ignore_dup_edges = FALSE) edge_set@bit_vector <- bv nn <- intersect(nodes(g1), nodes(g2)) ans <- new("graphBAM", edgeSet= edge_set, nodes =nn) attrType <- .Call(graph_bitarray_Intersect_Attrs, edge_set@bit_vector, e1@bit_vector, e2@bit_vector) if(length(attrType$from) >0) { edge_set@weights <- .getIntersectAttrs("weight", attrType, e1@weights, e2@weights, funList) } for(i in commonAttr) { ans@userAttrPos@edgePos[[i]] <- edge_set@bit_vector xAttr <- .retAttrVec(g1, i) yAttr <- .retAttrVec(g2, i) if(length(attrType$from) >0) { edge_set@edge_attrs[[i]] <- .getIntersectAttrs(i, attrType, xAttr, yAttr, funList) } } ans@edgeSet <- edge_set ans } .getUnionNodeUserAttrPos <- function(g, sg1, sg2) { cmnAttrs <- intersect(names(sg1@nodeData@defaults), names(sg2@nodeData@defaults)) unqAttrs <- unique(c(names(sg1@nodeData@defaults), names(sg2@nodeData@defaults))) singleAttrs <- unqAttrs[!( unqAttrs %in% cmnAttrs)] n1 <- structure(lapply(cmnAttrs, function(i){ len <- length(g@nodeData@data[[i]]) bt <- makebits(len) bt <- setbitv(bt, seq_len(len), rep(1L, len)) }),names = cmnAttrs) n2 <- structure(lapply(singleAttrs, function(i){ if(i %in% names(sg1@userAttrPos@nodePos)) return(sg1@userAttrPos@nodePos[[i]]) else if(i %in% names(sg2@userAttrPos@nodePos)) return(sg2@userAttrPos@nodePos[[i]]) }), names= singleAttrs) c(n1, n2) } .getIntNodeUserAttrPos <- function(sg1 , sg2) { nattr <- intersect(names(sg1@nodeData@defaults), names(sg2@nodeData@defaults)) structure(lapply(nattr, function(i) { bv <- sg1@userAttrPos@nodePos[[i]] & sg2@userAttrPos@nodePos[[i]] attributes(bv) <- attributes(sg1@userAttrPos@nodePos[[i]]) attr(bv, "nbitset") <- ns <- .Call(graph_bitarray_sum, bv) bv }), names = nattr) } .getIntersectAttrs <- function(att, attrType, xAtt , yAtt, funList ) { len <- length(attrType$from) from1 <- attrType$indx1 from2 <- attrType$indx2 k <- (as.numeric(attrType$from) ==0) attr1 <- vector(sum(k), mode =mode(xAtt)) attr1[seq_len(sum(k))] <- NA val1 <- xAtt[attrType$indx1[k]] val2 <- yAtt[attrType$indx2[k]] if(!is.null(funList) && (att %in% names(funList))) { attr1[k] <- sapply(seq_len(sum(k)), function(p) { return(funList[[att]](val1[[p]], val2[[p]])) }) } else if (is.vector(val1) && is.vector(val2)) { eqInd <- sapply(seq_len(length(val1)), function(x){ identical(val1[x], val2[x]) }) pt <- which(eqInd) attr1[pt] <- val1[pt] } attr1 } setMethod("graphIntersect", c("graphBAM", "graphBAM"), function(x, y, nodeFun, edgeFun, ...){ nn <- intersect(nodes(x), nodes(y)) nnLen <- length(nn) if(nnLen ==0) { dr1 <- isDirected(x) dr2 <- isDirected(y) if(dr1 != dr2) stop("'x' and 'y' should both be directed or undirected") theMode <- if (dr1) "directed" else "undirected" c0 <- character(0) df <- data.frame(from = c0, to = c0, weight = numeric(0), stringsAsFactors = FALSE) ans <- graphBAM(df, edgemode = theMode) return(ans) } sg1 <- if (nnLen == numNodes(x)) x else subGraph(nn, x) sg2 <- if (nnLen == numNodes(y)) y else subGraph(nn, y) if(missing(nodeFun)) nodeFun <- NULL if(missing(edgeFun)) edgeFun <- NULL edge_set <- .getEdgeIntersect(sg1@edgeSet, sg2@edgeSet) ans <- .getBAMIntersect(sg1, sg2, edge_set, edgeFun) ans@edgeData@defaults <- .retEdgeIntersectDefaults(sg1@edgeData@defaults, sg2@edgeData@defaults) ans@nodeData@defaults <- .retNodeIntersectDefaults(sg1, sg2) ans@userAttrPos@nodePos <- .getIntNodeUserAttrPos(sg1, sg2) ans@nodeData@data <- .nodeIntersect(sg1, sg2, ans, nodeFun) ans }) .getIntersectEdgeUserAttrPos <- function(edge_set) { nms <- names(edge_set@edge_attrs) structure(lapply(nms, function(){ edge_set@bit_vector }), names = nms) } .retNodeUnionDefaults <- function(sg1, sg2) { cmnAttrs <- intersect(names(sg1@nodeData@defaults), names(sg2@nodeData@defaults)) unqAttrs <- unique(c(names(sg1@nodeData@defaults), names(sg2@nodeData@defaults))) singleAttrs <- unqAttrs[!( unqAttrs %in% cmnAttrs)] cmn <- structure(lapply(cmnAttrs, function(x) { if(identical(sg1@nodeData@defaults[[x]], sg2@nodeData@defaults[[x]])) sg1@nodeData@defaults[[x]] else NA }), names = cmnAttrs) sng <- structure(lapply(singleAttrs, function(x) { if(x %in% names(sg1@nodeData@defaults)) sg1@nodeData@defaults[[x]] else sg2@nodeData@defaults[[x]] }), names = singleAttrs) c(cmn, sng) } .retNodeIntersectDefaults <- function(sg1, sg2) { cmnAttrs <- intersect(names(sg1@nodeData@defaults), names(sg2@nodeData@defaults)) structure(lapply(cmnAttrs, function(x) { if(identical(sg1@nodeData@defaults[[x]], sg2@nodeData@defaults[[x]])) sg1@nodeData@defaults[[x]] else NA }), names = cmnAttrs) } .retEdgeIntersectDefaults <- function(d1, d2) { cmnAttrs <- intersect(names(d1), names(d2)) structure(lapply(cmnAttrs, function(x) { if(identical(d1[[x]], d2[[x]])) d1[[x]] else NA }), names = cmnAttrs) } .retEdgeUnionDefaults <- function(sg1, sg2) { cmnAttrs <- intersect(names(sg1@edgeData@defaults), names(sg2@edgeData@defaults)) unqAttrs <- unique(c(names(sg1@edgeData@defaults), names(sg2@edgeData@defaults))) singleAttrs <- unqAttrs[!( unqAttrs %in% cmnAttrs)] cmn <- structure(lapply(cmnAttrs, function(x) { if(identical(sg1@edgeData@defaults[[x]], sg2@edgeData@defaults[[x]])) sg1@edgeData@defaults[[x]] else NA }), names = cmnAttrs) sng <- structure(lapply(singleAttrs, function(x) { if(x %in% names(sg1@edgeData@defaults)) sg1@edgeData@defaults[[x]] else sg2@edgeData@defaults[[x]] }), names = singleAttrs) c(cmn, sng) } .nodeIntersect <- function(sg1, sg2, ans, funList){ cmn <- intersect(names(sg1@nodeData@defaults), names(sg2@nodeData@defaults)) nattr <- structure(lapply(cmn, function(x) { attr1 <- .getNodeAttrVec(sg1, x) attr2 <- .getNodeAttrVec(sg2, x) len <- length(attr1) if(!is.null(funList) && (x %in% names(funList))) { res <- sapply(seq_len(len), function(p) { return(funList[[x]](attr1[[p]], attr2[[p]])) }) } else if (is.vector(attr1) && is.vector(attr2)) { indx <- which(sapply(seq_len(len), function(p){ identical(attr1[p], attr2[p]) })) res <- rep(NA, len) res[indx] <- attr1[indx] } res res[bitToLogical(ans@userAttrPos@nodePos[[x]])] }), names = cmn) nattr } .scaleGraphBAM <- function(g, theNodes, edgemode) { if(all(nodes(g) %in% theNodes) && length(nodes(g)) == length(theNodes)) return(g) else { ndsLen <- length(theNodes) df <- extractFromTo(g) bam <- graphBAM(df, nodes = theNodes, edgemode= edgemode, ignore_dup_edges = FALSE) bam@edgeSet@weights <- g@edgeSet@weights bam@edgeSet@edge_attrs <- g@edgeSet@edge_attrs bam@edgeData@defaults <- g@edgeData@defaults nms <- names(g@nodeData@defaults) for(i in nms){ origNds <- nodes(g)[(bitToLogical(g@userAttrPos@nodePos[[i]]))] indx <- match(origNds, theNodes) bt <- makebits(ndsLen) bt <- setbitv(bt, indx, rep(1L, length(indx))) bam@userAttrPos@nodePos[[i]] <- bt bam@nodeData@data[[i]] <- g@nodeData@data[[i]] } bam@nodeData@defaults <- g@nodeData@defaults nms <- names(g@userAttrPos@edgePos) for(i in nms) { ft <- .Call(graph_bitarray_rowColPos, g@userAttrPos@edgePos[[i]]) posBit <- .createZeroBitPos(ndsLen) bam@userAttrPos@edgePos[[i]] <- setBitCell(posBit, ft[,"from"], ft[,"to"], rep(1L, nrow(ft))) } return(bam) } } .bamUnion <- function(g1, g2, theNodes, nodeFun, edgeFun) { dr1 <- isDirected(g1) dr2 <- isDirected(g2) if(dr1 != dr2) stop("edges should both be directed or undirected") theMode <- if (dr1 && dr2) "directed" else "undirected" e1Attr <- names(g1@edgeSet@edge_attrs) e2Attr <- names(g2@edgeSet@edge_attrs) unionAttr <- unique(union(e1Attr, e2Attr)) if(!is.null(edgeFun)) { fIndx <- names(edgeFun) %in% c(unionAttr, "weight") if(!all(fIndx)) stop("attributes in 'edgeFun' not in edge attributes: ", pasteq(names(edgeFun)[fIndx])) } bam1 <- .scaleGraphBAM(g1, theNodes, theMode) bam2 <- .scaleGraphBAM(g2, theNodes, theMode) bv <- bam1@edgeSet@bit_vector | bam2@edgeSet@bit_vector attributes(bv) <- attributes(bam1@edgeSet@bit_vector) attr(bv, "nbitset") <- ns <- .Call(graph_bitarray_sum, bv) c0 <- character(0) df <- data.frame(from = c0, to = c0, weight = numeric(0), stringsAsFactors = TRUE) edge_set <- .makeMDEdgeSet(es_name = 1, es =df, is_directed = (theMode == "directed"), nodes = theNodes, ignore_dup_edges = FALSE) edge_set@bit_vector <- bv ans <- new("graphBAM", edgeSet= edge_set, nodes =theNodes) cmnBit <- bam1@edgeSet@bit_vector & bam2@edgeSet@bit_vector attributes(cmnBit) <- attributes(bam1@edgeSet@bit_vector) attr(cmnBit, "nbitset") <- .Call(graph_bitarray_sum, cmnBit) fromOneBit <- bam1@edgeSet@bit_vector & (!cmnBit) attributes(fromOneBit) <- attributes(bam1@edgeSet@bit_vector) attr(fromOneBit, "nbitset") <- .Call(graph_bitarray_sum, fromOneBit) fromTwoBit <- bam2@edgeSet@bit_vector & (!cmnBit) attributes(fromTwoBit) <- attributes(bam2@edgeSet@bit_vector) attr(fromTwoBit, "nbitset") <- .Call(graph_bitarray_sum, fromTwoBit) attrType <- .Call(graph_bitarray_Union_Attrs, bv, cmnBit, fromOneBit, fromTwoBit) if(length(attrType$from) >0) { edge_set@weights <- as.numeric(.getUnionWeights(attrType, bam1, bam2, edgeFun)) } if(!is.null(unionAttr)) { for(i in unionAttr) { ans@userAttrPos@edgePos[[i]] <- edge_set@bit_vector edge_set@edge_attrs[[i]] <- .getUnionAttrs(i, attrType, bam1, bam2, edgeFun) } } ans@edgeSet <- edge_set ans@nodeData@data <- .nodeUnion(g1, g2, nodeFun) ans@userAttrPos@nodePos <- .getUnionNodeUserAttrPos(ans,bam1, bam2) ans } setMethod("graphUnion", c("graphBAM", "graphBAM"), function(x, y, nodeFun, edgeFun, ...) { theNodes <- unique(c(nodes(x), nodes(y))) nnLen <- length(theNodes) if(nnLen ==0) { dr1 <- isDirected(x) dr2 <- isDirected(y) if(dr1 != dr2) stop("'x' and 'y' should both be directed or undirected") theMode <- if (dr1) "directed" else "undirected" c0 <- character(0) df <- data.frame(from = c0, to = c0, weight = numeric(0), stringsAsFactors = FALSE) ans <- graphBAM(df, edgemode = theMode) return(ans) } if(missing(nodeFun)) nodeFun <- NULL if(missing(edgeFun)) edgeFun <- NULL ans <- .bamUnion(x, y, theNodes, nodeFun, edgeFun) ans@nodeData@defaults <- .retNodeUnionDefaults(x, y) ans@edgeData@defaults <- .retEdgeUnionDefaults(x, y) ans }) .nodeUnion <- function(g1, g2, funList) { xAttr <- names(g1@nodeData@defaults) yAttr <- names(g2@nodeData@defaults) if(!is.null(funList)) { fIndx <- names(funList) %in% c(xAttr, yAttr) if(!all(fIndx)) stop("attributes in 'nodeFun' not in node attributes: ", pasteq(names(funList)[fIndx])) } ndX <- nodes(g1) ndY <- nodes(g2) ndAns <- unique(c(ndX, ndY)) unionAttrs <- union(xAttr, yAttr) commonAttrs <- intersect(xAttr,yAttr) singleAttrs <- unionAttrs[!unionAttrs %in% commonAttrs] cmnNds <- intersect(ndX, ndY) fxNds <- ndX[!ndX %in% cmnNds] fyNds <- ndY[!ndY %in% cmnNds] ### deal with single attrs n1 <- sapply(singleAttrs, function(k){ if(k %in% xAttr){ att <- .getNodeAttrVec(g1, k) } else if(k %in% yAttr){ att <- .getNodeAttrVec(g2, k) } list(att) }) n2 <- sapply(commonAttrs, function(k) { att <- rep(NA, length(ndAns)) ##from X indx <- match(fxNds, ndAns) attr1 <- .getNodeAttrVec(g1, k) attr2 <- .getNodeAttrVec(g2, k) att[indx] <- attr1[match(fxNds,ndX)] ##from Y indx <- match(fyNds, ndAns) att[indx] <- attr2[match(fyNds,ndY)] if(!is.null(funList) && (k %in% names(funList))) { tmp <- sapply(cmnNds, function(p){ dX <- match(p, ndX) dY <- match(p, ndY) funList[[k]](attr1[[dX]], attr2[[dY]]) }, USE.NAMES = FALSE) indx <- match(cmnNds, ndAns) att[indx] <- tmp } else if (is.vector(attr1) && is.vector(attr2)){ tmp <- sapply(cmnNds, function(p){ dX <- match(p, ndX) dY <- match(p, ndY) identical(attr1[[dX]], attr2[[dY]]) }, USE.NAMES = FALSE) indx <- match(cmnNds[tmp], ndAns) att[indx] <- attr1[match(cmnNds[tmp], ndX)] } list(att) }) c(n1,n2) } setMethod("nodeDataDefaults", signature(self="graphBAM", attr="missing"), function(self, attr){ attrDefaults(self@nodeData) }) setMethod("nodeDataDefaults", signature(self="graphBAM", attr="character"), function(self, attr){ attrDefaults(self@nodeData, attr) }) setReplaceMethod("nodeDataDefaults", signature(self="graphBAM", attr="missing", value="list"), function(self, attr, value) { attrDefaults(self@nodeData) <- value nmsNds <- names(self@nodeData@defaults) nmsAttr <- names(self@userAttrPos@nodePos) ndsLbls <- nmsNds[ !(nmsNds %in% nmsAttr)] if(length(ndsLbls)) { ndsLen <- length(nodes(self)) bt <- makebits(ndsLen) } for(i in ndsLbls) { self@userAttrPos@nodePos[[i]] <- bt } self }) setReplaceMethod("nodeDataDefaults", signature(self="graphBAM", attr="character", value="ANY"), function(self, attr, value) { attrDefaults(self@nodeData, attr) <- value ndsLen <- length(nodes(self)) if(! (attr %in% names(self@userAttrPos@nodePos))){ bt <- makebits(ndsLen) self@userAttrPos@nodePos[[attr]] <- bt } self }) ## Node data replacement methods .getNodeAttrOrder <- function(x, indx) { len <- attr(x, "bitlen") nset <- attr(x, "nbitset") if (is.null(len)) len <- length(x) * 8L k <- p <- 1 setIndx = 1 attrIndx = 1 k2<- k3 <- k1 <- 1 nval = vector(length(indx), mode ="integer") npos <- nval fpos = vector(max(c(nset, length(indx))), mode ="integer") fval = vector(max(c(nset, length(indx))), mode ="integer") mm <- length(indx) for( i in seq_len(len)) { bt <- testbit(x, i) intIndx <- indx[attrIndx] if(bt) { if(intIndx == i) { nval[k2] = attrIndx npos[k2] = k3 k2 <- k2 + 1 k3 <- k3 + 1 if(attrIndx < mm) attrIndx = attrIndx +1 } if(intIndx != i){ fpos[k1] <- setIndx fval[k1] <- k1 k1 <- k1+1 k3 <- k3+ 1 } setIndx <- setIndx +1 } } length(fpos) <- k1-1 length(fval) <- k1-1 attributes(fval) <- list("origPos" = fpos) attributes(nval) <- list("newPos" = npos) list( origVal = fval, newVal = nval) } setReplaceMethod("nodeData", signature(self = "graphBAM", n="character", attr="character", value="ANY"), function(self, n, attr, value) { .nodeDataReplaceNodeGiven(self, n ,attr, value) }) setReplaceMethod("nodeData", signature(self = "graphBAM", n="missing", attr="character", value="ANY"), function(self, n, attr, value) { .nodeDataReplaceNodeMissing(self, attr, value) }) .getNodeAttrPos <- function(x, indx) { bt <- bitToLogical(x) leftPos <- which(bt[indx]) cs <- cumsum(bt) k <- indx[bt[indx]] rightPos <- cs[k ] list(leftPos= leftPos, rightPos = rightPos) } ## Node data accces methods setMethod("nodeData", signature(self = "graphBAM", n = "character", attr = "character"), function(self, n, attr) { .nodeDataRetrieve(self, n, attr) }) setMethod("nodeData", signature(self = "graphBAM", n = "missing", attr = "character"), function(self, n, attr) { if(length(attr) != 1L) stop("'attr' must specify a single attribute name") nds <- nodes(self) nodeData(self, n= nds, attr= attr) }) setMethod("nodeData", signature(self = "graphBAM", n = "character", attr = "missing"), function(self, n, attr) { nds <- nodes(self) .verifyNodes(n ,nds) nms <- names(self@nodeData@defaults) structure(lapply(nms, function(x) { nodeData(self, n, x) }), names = nms) }) setMethod("nodeData", signature(self = "graphBAM", n = "missing", attr = "missing"), function(self, n, attr) { nds <- nodes(self) nms <- names(self@nodeData@defaults) structure(lapply(nms, function(x) { nodeData(self, nds, x) }), names = nms) }) graph/R/methods-multiGraph.R0000644000175000017500000000752314136046755015630 0ustar nileshnilesh##some methods for the multigraph class setMethod("show", signature("multiGraph"), function(object) { numNodes<- numNodes(object) cat("A", class(object), "with \n") cat("Number of nodes =", numNodes, "\n") cat("Number of edge lists =", length(object@edgeL), "\n") }) setMethod("isDirected", "multiGraph", function(object) sapply(object@edgeL, isDirected)) setMethod("nodes", signature(object="multiGraph"), function(object) object@nodes) setMethod("numNodes", signature(object="multiGraph"), function(object) length(nodes(object))) setMethod("edges", signature(object="multiGraph"), function(object, which) { nV = nodes(object) if (missing(which)) which <- nV lapply(object@edgeL, function(x) edges(x, which, nV)) }) setMethod("numEdges", signature(object="MGEdgeSet"), function(object) { attr(object@bit_vector, "nbitset") }) setMethod("numEdges", signature(object="multiGraph"), function(object) { sapply(object@edge_sets, numEdges) }) # #numEHelper = function(gEdges, directed) { # if (length(gEdges) == 0) # return(length(gEdges)) # numEdges <- length(unlist(gEdges, use.names=FALSE)) # if (directed) { # numSelfLoops <- sum(mapply(function(e, n) sum(n == e), # gEdges, names(gEdges))) # numEdges <- numSelfLoops + (numEdges - numSelfLoops) / 2 # } # numEdges #} # #setMethod("numEdges", signature(object="multiGraph"), # function(object) { # gEdges <- edges(object) # dir <- isDirected(object) # ans <- rep(NA, length(dir)) # for(i in 1:length(dir)) # ans[i] = numEHelper(gEdges[[i]], dir[i]) # ans # }) # ##we need a validity checking method: ensure that nodes are the same ##in all edgeSets - which is hard as the edgeSets don't always seem to ##know #####edgeSet methods here ##this is a bit dangerous as these are not really the nodes of the ##graph - we don't enforce having all nodes in the adj matrix setMethod("isDirected", "edgeSet", function(object) edgemode(object) == "directed") setMethod("edgemode", "edgeSet", function(object) edgemode(object)) setMethod("show", signature("edgeSet"), function(object) { numEdge<-numEdges(object) cat("A", class(object), "with", edgemode(object), "edges\n") cat("Number of Edges =", numEdge, "\n") }) ###edgeSetAM methods setMethod("nodes", signature(object="edgeSetAM"), function(object) rownames(object@adjMat)) setMethod("edges", signature(object="edgeSetAM"), function(object, which, nodes) { stopifnot( is.character(which) ) stopifnot( is.character(nodes) ) idx <- base::which(colnames(object@adjMat) %in% which) getEdgeList(object@adjMat[idx, ], nodes[idx]) }) setMethod("numEdges", signature(object="edgeSetAM"), function(object) { nE <- sum(object@adjMat != 0) if (!isDirected(object)) { selfLoops <- sum(diag(object@adjMat) != 0) nE <- selfLoops + (nE - selfLoops)/2 } nE }) ##edgeSetNEL methods here ##and here we are a bit scuppered by the way we represent the edge ##lists - we need to have the node set around setMethod("edges", signature(object="edgeSetNEL"), function(object, which, nodes) { stopifnot( is.character(which) ) stopifnot( is.character(nodes) ) lapply(object@edgeL[which], function(x) nodes[x$edges])}) graph/R/toDotWithRI.R0000644000175000017500000001245414136046755014232 0ustar nileshnilesh.invertListOfLists <- function(x) { if (length(x) == 0) { return(list()) } numItems <- length(x[[1]]) resList.inverted <- vector(mode="list", length=numItems) for (i in seq_len(numItems)) { resList.inverted[[i]] <- lapply(x, "[[", i=i) } names(resList.inverted) <- names(x[[1L]]) resList.inverted } .wrapID <- function(id) { if (is.null(id) || id == "") { NULL } else { paste0("\"", id, "\"") } } .wrapAttrVal <- function(id) { id_names <- names(id) isHTML <- grepl("^<.*>$", id) ## escape the newlines id[!isHTML] <- paste0("\"", gsub("\n", "\\\n", id[!isHTML], fixed=TRUE), "\"") names(id) <- id_names id } .splitRenderInfo <- function(renderInfo.list) { ## extract the attributes that are global attr_names <- names(renderInfo.list) global <- list() local <- list() for (attr_name in attr_names) { if (length(unique(renderInfo.list[[attr_name]])) == 1) { global[[attr_name]] <- unique(renderInfo.list[[attr_name]]) } else { local[[attr_name]] <- renderInfo.list[[attr_name]] } } list(global=global, local=.invertListOfLists(local)) } .splitNodeRenderInfo <- function(graph) { nri <- nodeRenderInfo(graph) .splitRenderInfo(nri) } .splitEdgeRenderInfo <- function(graph) { eri <- edgeRenderInfo(graph) .splitRenderInfo(eri) } .print_attr_list <- function(attr_list) { ## make the attribute list double-quoted strings; ## with escapted newline characters attr_vec <- unlist(attr_list, use.names=TRUE) if (length(attr_vec) == 0) { return("[]") } attr_vec <- attr_vec[!is.na(attr_vec)] attr_vec <- .wrapAttrVal(attr_vec) if (length(attr_vec) > 0) { foo <- paste(names(attr_vec), attr_vec, sep="=", collapse = ", ") paste0("[", foo, "]") } else { "[]" } } .print_node_stmt <- function(node_id, attr_list) { node_id <- .wrapID(node_id) paste( node_id, .print_attr_list(attr_list)) } .print_edge_stmt <- function(edge_id, attr_list, edgeop) { ## name uses a tilde between nodes as teh edgename nodes <- strsplit(edge_id, "~", fixed=TRUE)[[1L]] nodes <- .wrapID(nodes) edge_id <- paste(nodes[1L], edgeop, nodes[2L]) paste(edge_id, .print_attr_list(attr_list)) } .print_attr_stmt <- function(type, attr_list) { paste(type, .print_attr_list(attr_list)) } .print_stmt_list_fromGraph <- function(graph, edgeop) { ##print the graph, edges and nodes graph_attr_list <- graphRenderInfo(graph) node_RI_split <- .splitNodeRenderInfo(graph) edge_RI_split <- .splitEdgeRenderInfo(graph) ## print global graph attributes graph_printed <- .print_attr_stmt("graph", graph_attr_list) ## print global node attributes nodes_printed <- character(length(nodes(graph)) + 1L) nodes_printed[1L] <- .print_attr_stmt("node", node_RI_split$global) ## then ensure only renderInfo of present nodes is used locally ## and in correct order i <- 2L for (node_id in nodes(graph)) { nodes_printed[i] <- .print_node_stmt(node_id=node_id, attr_list=node_RI_split$local[[node_id]]) i <- i + 1L } ## print the global edge attributes if (edgeop == "->") { ## directed edge_names <- edgeNames(graph, recipEdges="distinct") } else { edge_names <- edgeNames(graph, recipEdges="combined") } edges_printed <- character(length(edge_names) + 1L) edges_printed[1L] <- .print_attr_stmt("edge", edge_RI_split$global) ## then ensure that only renderInfo of present edges is used and ## in correct order i <- 2L for (edge_id in edge_names) { edges_printed[i] <- .print_edge_stmt(edge_id=edge_id, attr_list=edge_RI_split$local[[edge_id]], edgeop=edgeop) i <- i + 1L } paste0(c(graph_printed, nodes_printed, edges_printed), ";") } .print_subgraph <- function(subgraph_id, subgraph, edgeop) { first_line <- paste("subgraph", .wrapID(subgraph_id), "{") last_line <- "}" stmt_list <- .print_stmt_list_fromGraph(subgraph, edgeop) c(first_line, stmt_list, last_line) } ## see ?toDotWithRI toDotWithRI <- function(graph, graph_name=NULL, subGraphList=list(), isStrict=TRUE) { ## check for the correct class if (!inherits(graph, "graph")) { stop("graph has to inherit from class graph") } if (!all(unlist(lapply(subGraphList, inherits, what="graph")))) { stop("all elements in subGraphList must inherit from class graph") } if (isStrict) { strict_item <- "strict" } else { strict_item <- NULL } if (isDirected(graph)) { graph_type <- "digraph" edgeop <- "->" } else { graph_type <- "graph" edgeop <- "--" } printed_graph_stmts <- .print_stmt_list_fromGraph(graph, edgeop) printed_subgraph_list <- vector("list", length(subGraphList)) for (i in seq_along(subGraphList)) { printed_subgraph_list[[i]] <- .print_subgraph(names(subGraphList)[i], subGraphList[[i]], edgeop) } c(paste(strict_item, graph_type, .wrapID(graph_name), "{"), printed_graph_stmts, unlist(printed_subgraph_list), "}") } graph/R/mat2graph.R0000644000175000017500000001022314136046755013727 0ustar nileshnileshaM2bpG<-function(aM){ if(is.null(rownames(aM))) stop("'aM' must have row names") if(is.null(colnames(aM))) stop("'aM' must have column names") V <- c(rownames(aM),colnames(aM)) tmat<-which(aM>0,arr.ind=TRUE) tmat[,2] <- tmat[,2] + dim(aM)[1] numN<-length(V) numE<-dim(tmat)[1] rval <- vector("list", length = numN) for (i in seq_len(numE)) { rval[[tmat[i, 1]]]$edges <- c(rval[[tmat[i, 1]]]$edges, tmat[i, 2]) ln <- length(rval[[tmat[i, 1]]]$edges) rval[[tmat[i, 1]]]$weights <- c(rval[[tmat[i, 1]]]$weights, aM[tmat[i,1],(tmat[i,2]-dim(aM)[1])]) names(rval[[tmat[i, 1]]]$weights)[ln] <- tmat[i, 2] } names(rval) <- V graphNEL(nodes = V, edgeL = rval, edgemode="directed") } ## WH 23 June 2004, Ladir CH ftM2adjM <- function(ft, W=NULL, V=NULL, edgemode="directed") .ftM2other(ft, W, V, edgemode, "adjM") ftM2graphNEL <- function(ft, W=NULL, V=NULL, edgemode="directed") .ftM2other(ft, W, V, edgemode, "graphNEL") .ftM2other <- function(ft, W, V, edgemode, targetclass) { ## ft: nx2 matrix. if(!(is.matrix(ft) && ncol(ft)==2)) stop("'ft' must be an nx2 matrix") numE <- nrow(ft) ## deal with W if(is.null(W)) W <- rep(1,numE) if(!length(W)==numE) stop("length of 'W' must equal number of edges in 'ft'") ## deal with edgemode if(!edgemode %in% c("undirected", "directed")) stop("'edgemode' must be 'directed' or 'undirected'") if(edgemode == "undirected") { ## reflect each pair -- but *not* the self-edges! differ <- ft[,1] != ft[,2] ft <- rbind(ft, ft[differ, 2:1]) W <- c( W, W[differ]) } ## deal with V cft <- as.character(ft) if(is.null(V)) V <- unique(cft) ift <- array(match(cft, V), dim=dim(ft)) if(any(is.na(ift))) stop("node names in 'ft' must be in 'V'") numN <- length(V) ind <- ift[,1]+(ift[,2]-1)*numN if(any(duplicated(ind))) stop("duplicate edges not allowed") switch(targetclass, adjM = { mat <- matrix(0, ncol=numN, nrow=numN, dimnames=list(V,V)) mat[ind] <- W mat }, graphNEL = { ## ift[,2] are the indices of the to-nodes in V ## ft[,1] are the names of the from-nodes ## toN is a named list, whose names are the levels of ft[,1] and whose elements are the indices of to-nodes in V ## names(toN) is a subset of V, but not identical: the nodes with no outgoing edges are not in names(toN) ## Beware of partial matching! (This lead to a bug in earlier versions of this function, where edges were ## invented if there were nodes with no outgoing edges whose name partially matched the name of other ## nodes with outgoing edges. toN <- split(ift[,2], ft[,1]) eW <- split(W, ft[,1]) edgeL <- lapply(V, function(x) list(edges=NULL, weights=NULL)) names(edgeL) <- V mt = match(names(toN), V) for(k in seq(along=mt)) edgeL[[mt[k]]] <- list(edges=toN[[k]], weights=eW[[k]]) graphNEL(nodes=V, edgeL=edgeL, edgemode=edgemode) }, stop("'targetclass' unknown: ", sQuote(targetclass)) ) ## end switch } setAs("matrix", "graphAM", function(from) { if(!identical(ncol(from), nrow(from))) stop("'ncol(from)' and 'nrow(from)' must be identical") if(is.null(rownames(from))) { rownames(from) = if(is.null(colnames(from))) { paste(seq_len(nrow(from))) } else { colnames(from) } } if(is.null(colnames(from))) { colnames(from) = if(is.null(rownames(from))) { paste(seq_len(ncol(from))) } else { rownames(from) } } if(!identical(rownames(from),colnames(from))) stop("'rownames(from)' and 'colnames(from)' must be identical") if(!is.numeric(from)) storage.mode(from) = "integer" emode <- if (all(from == t(from))) "undirected" else "directed" defaultWeight <- vector(mode = typeof(from), length = 1L) defaultWeight[1L] <- 1L graphAM (from, edgemode=emode, values=list(weight=defaultWeight)) }) setAs("matrix", "graphNEL", function(from) as(as(from, "graphAM"), "graphNEL")) setAs("graphNEL", "matrix", function(from) { as(as(from, "graphAM"), "matrix") }) graph/R/NELhandler.R0000644000175000017500000001017514136046755014024 0ustar nileshnileshNELhandler <- function () { # # this function is to work with omegahat's XML xmlEventParse # current version: given a GXL graph, capture the node names and # edge data to return the graph as graph::graphNEL # graphID <- NULL curNode <- NULL curEdge <- NULL curAttr <- NULL inNode <- FALSE inEdge <- FALSE inAttr <- FALSE nodeL <- list() edgeL <- list() edgemode <- NULL # # handler elements: start elements are cased for # graph, node, attr, or edge # text is limited in the simple example to the attr tag, # which lives under a node or an edge # startElement = function(x, atts, ...) { if (x == "graph") { graphID <<- atts["id"] edgemode <<- atts["edgemode"] } else if (x == "node") { inNode <<- TRUE nodeL[[atts["id"]]] <<- list() curNode <<- atts["id"] } else if (x == "attr") { inAttr <<- TRUE curAttr <<- atts["name"] } else if (x == "edge") { inNode <<- FALSE inEdge <<- TRUE edgeL[[atts["id"]]] <<- list() edgeL[[atts["id"]]][["span"]] <<- c(atts["from"], atts["to"]) curEdge <<- atts["id"] } } text = function(x, atts, ...) { if (inNode & inAttr & nchar(x) > 0) nodeL[[curNode]][[curAttr]] <<- x else if (inEdge & inAttr & nchar(x) > 0) edgeL[[curEdge]][[curAttr]] <<- c(edgeL[[curEdge]][[curAttr]], x) } endElement = function(x, ...) { if (x == "attr") inAttr <<- FALSE else if (x == "node") inNode <<- FALSE else if (x == "edge") inEdge <<- FALSE } dump = function() { list(graphID = graphID, nodeL = nodeL, edgeL = edgeL, edgemode = edgemode) } asGraphNEL = function() { # # revised Jun 16 2004 # when callsed, nodeL is the named list of node data, edgeL is # named list of edge data (unrelated to edgeL of graphNEL!!!) # ns <- names(nodeL) if (length(edgeL) == 0) return(graphNEL(nodes = ns, edgemode = edgemode)) # # edgeL has a span element giving source and destination of each # edge # src <- sapply(edgeL, function(x) x$span["from"]) dest <- sapply(edgeL, function(x) x$span["to"]) wts <- sapply(edgeL, function(x) as.numeric(x$weights)) NOWTS <- FALSE if (all(sapply(wts,length)==0)) NOWTS <- TRUE names(wts) <- dest # # graphNEL edgeL structure is a named list with one element # for each node of graph. the edges component for a node N # has node indices of the destinations of each edge starting at N # desti <- match(dest, ns) edl <- split(desti, src) wtl <- split(wts, src) for (i in seq_along(ns)) { if (length(edl[[ns[i]]]) == 0) edl[[ns[i]]] <- list(edges = integer(0)) else if (!NOWTS) edl[[ns[i]]] <- list(edges = edl[[ns[i]]], weights=wtl[[ns[i]]]) else edl[[ns[i]]] <- list(edges = edl[[ns[i]]]) } edl <- edl[ns] if (edgemode %in% c("undirected", "defaultundirected")) edgemode <- "undirected" else edgemode <- "directed" g <- graphNEL(nodes = ns, edgeL = edl, edgemode = edgemode) if (edgemode(g) == "undirected") { edgemode(g) <- "directed" # allow ugraph to do something g <- ugraph(g) edgemode(g) <- "undirected" } if (!validGraph(g)) { msg <- "GXL did not define a valid graph package graphNEL object. Most likely there is a failure of reciprocity for edges in an undirected graph. If there is a node for edge from A to B in an undirected graphNEL, there must also be an edge from B to A." stop(paste0(c("", strwrap(msg)), collapse="\n")) } return(g) } list(startElement = startElement, endElement = endElement, text = text, dump = dump, asGraphNEL = asGraphNEL) } graph/inst/0000755000175000017500000000000014136072220012457 5ustar nileshnileshgraph/inst/perf/0000755000175000017500000000000014136046755013431 5ustar nileshnileshgraph/inst/perf/multigraphs.Rnw0000644000175000017500000000450114136046755016460 0ustar nileshnilesh\documentclass{article} \usepackage{hyperref} \textwidth=6.2in \textheight=8.5in \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Rmethod}[1]{{\texttt{#1}}} \newcommand{\Rcode}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \newcommand{\Rclass}[1]{{\textit{#1}}} \newcommand{\classdef}[1]{% {\em #1} } \newcommand{\myincfig}[3]{\begin{figure}[htbp] \begin{center} \includegraphics[width=#2]{#1} \caption{\label{#1}#3} \end{center} \end{figure}} \begin{document} \title{Experimental Support for Multigraphs} \author{Seth Falcon} \maketitle \SweaveOpts{keep.source=TRUE} <>= st <- system.time @ \section{Introduction} The MultiGraph class represents a single node set and a set of edge sets. Each edge set is either directed or undirected. We can think of an edge in a MultiGraph as a 4-tuple (from-node, to-node, edge-type, weight), where the edge-type field in the tuple identifies the edge set, the weight is a numeric value, and the order of the nodes only matters in the case of a directed edge set. Unlike some of the graph representations, self-loops are allowed (from-node == to-node). There is support for arbitrary edge attributes which is primarily useful for rendering plots of MultiGraphs. These attributes are stored separately from the edge weights to facilitate efficient edge weight computation. <>= library("graph") set.seed(0xab34eL) ft1 <- graph:::randFromTo(10000L, 1e6L) ft2 <- graph:::randFromTo(10000L, 1e6L) ft3 <- graph:::randFromTo(30000L, 1e6L) names(ft1) head(ft1$nodes) head(ft1$ft) esets <- list(e1=ft1$ft, e2=ft2$ft, e3=ft3$ft) ## order(to_i, from_i) is a big factor here st(g <- MultiGraph(esets)) object.size(esets) / 1024^2 object.size(g) / 1024^2 g numNodes(g) ## we should be able to make numEdges faster by ## memoizing and/or just taking length of weight ## vector. st(numEdges(g)) st(lapply(eweights(g), head)) ## this is slow because of string creation, I suspect st(lapply(eweights(g, "=>"), head)) ## a good portion is in new and initialize st(gi <- edgeSetIntersect0(g)) gi st(degree(g)) st(extractFromTo(g)) nds <- nodes(g) subNds <- sample(nds,0.5*length(nds)) st(subGraph(subNds,g)) @ \end{document} graph/inst/perf/bgt.R0000644000175000017500000000620214136046755014330 0ustar nileshnilesh## Basic Graph Tests ## Each test has: ## - an input graph specified as an edge list ## - an operation name (or should it be the function? ## - an expected result. If the result is a graph object, it will ## be expressed as an edge list. ## ## Do we need a way to indicate nodes with no edges? ## makeFT <- function(from, to) { ord <- order(from) from <- from[ord] to <- to[ord] cbind(from, to) } basicDirected <- function() { from <- c("b", "b", "b", "i", "o", "c", "c", "e") to <- c("e", "i", "s", "o", "c", "i", "o", "c") w <- seq_len(length(to)) list(nodes = letters[1:20], edges = makeFT(from, to), weights = w, edgemode = "directed") } basicUndirected <- function() { from <- c("b", "b", "b", "i", "c", "e") to <- c("e", "i", "s", "o", "o", "c") w <- seq_len(length(to)) list(nodes = letters[1:20], edges = makeFT(from, to), weights = w, edgemode = "undirected") } basic_to_ft <- function(g) { from <- match(g$edges[, 1L], g$nodes) to <- match(g$edges[, 2L], g$nodes) ft <- cbind(from, to) ft } create <- list( "graphAM" = function(gDesc) { ft <- basic_to_ft(gDesc) numNodes <- length(gDesc$nodes) mat <- matrix(0L, nrow = numNodes, ncol = numNodes, dimnames = list(NULL, gDesc$nodes)) coord <- graph:::coordToIndex(ft[, 1L], ft[, 2L], numNodes) w <- gDesc$weights if (gDesc$edgemode == "undirected") { coord <- c(coord, graph:::coordToIndex(ft[, 2L], ft[, 1L], numNodes)) w <- c(w, w) } mat[coord] <- w graphAM(adjMat = mat, edgemode = gDesc$edgemode, values = list(weight = 1L)) }, "graphNEL" = function(gDesc) { edgeL <- split(gDesc$edges[ , 2L], gDesc$edges[ , 1L]) if (gDesc$edgemode == "undirected") { f <- gDesc$edges[, 1L] t <- gDesc$edges[, 2L] ft <- c(f, t) tf <- c(t, f) edgeL <- split(tf, ft) } g <- graphNEL(nodes = gDesc$nodes, edgeL = edgeL, edgemode = gDesc$edgemode) edgeDataDefaults(g, attr = "weight") <- 1L edgeData(g, from = gDesc$edges[, 1L], to = gDesc$edges[, 2L], attr = "weight") <- gDesc$weights g }) graph2desc <- function(g) { nms <- nodes(g) ft <- t(edgeMatrix(g)) from <- nms[ft[, 1L]] to <- nms[ft[, 2L]] list(nodes = nms, edges = makeFT(from, to), weights = unlist(edgeWeights(g), use.names = FALSE), edgemode = edgemode(g)) } toGraphDesc <- list("graphAM" = graph2desc, "graphNEL" = graph2desc) gam <- create$graphAM(basicDirected()) gnel <- create$graphNEL(basicDirected()) gam0 <- toGraphDesc$graphAM(gam) gnel0 <- toGraphDesc$graphNEL(gnel) ugam <- create$graphAM(basicUndirected()) ugnel <- create$graphNEL(basicUndirected()) graph/inst/perf/Makefile0000644000175000017500000000035414136072220015055 0ustar nileshnileshBASE = graphperf R ?= R-devel all: $(BASE).pdf @echo "building perf report using $(R)" $(BASE).pdf: $(BASE).tex $(R) CMD texi2dvi --pdf -c -q $< $(BASE).tex: $(BASE).Rnw $(R) CMD Sweave $< clean: @rm -fv $(BASE).pdf $(BASE).tex graph/inst/perf/graphperf.Rnw0000644000175000017500000002475514136046755016114 0ustar nileshnilesh\documentclass{article} \usepackage{hyperref} \textwidth=6.2in \textheight=8.5in \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Rmethod}[1]{{\texttt{#1}}} \newcommand{\Rcode}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \newcommand{\Rclass}[1]{{\textit{#1}}} \newcommand{\classdef}[1]{% {\em #1} } \newcommand{\myincfig}[3]{\begin{figure}[htbp] \begin{center} \includegraphics[width=#2]{#1} \caption{\label{#1}#3} \end{center} \end{figure}} \begin{document} \title{Graph Package Performance Report} \author{Seth Falcon} \maketitle \SweaveOpts{keep.source=TRUE} <>= st <- system.time perfRow <- function(g, t, op="") { data.frame(class = class(g), op = op, nodes = numNodes(g), edges = numEdges(g), directed = ifelse(isDirected(g), "T", "F"), user = t[1], sys = t[2], clock = t[3], stringsAsFactors = FALSE) } timeRow <- function(expr, op) { t <- system.time(g <- expr) list(result=g, row=perfRow(g, t, op)) } randNonDiagIndex <- function(n, count) { diagIdx <- 1L + 0L:(n - 1L) * (n + 1L) idx <- seq_len(n^2)[-diagIdx] sample(idx, count) } randAdjMat <- function(nodeCount, edgeCount) { nodes <- paste("graph_node_", seq_len(nodeCount), sep="") am <- matrix(0L, nrow = nodeCount, ncol = nodeCount, dimnames = list(nodes, nodes)) am[randNonDiagIndex(nodeCount, edgeCount)] <- 1L am } randSymAdjMat <- function(nodeCount, edgeCount) { nodes <- paste("graph_node_", seq_len(nodeCount), sep="") am <- matrix(0L, nrow = nodeCount, ncol = nodeCount, dimnames = list(nodes, nodes)) upt <- as.vector(upper.tri(am)) idx1 <- sample(seq_len(nodeCount^2)[upt], edgeCount) am[idx1] <- 1L am <- am + t(am) am } @ \section{Introduction} <>= library("graph") set.seed(0xab34eL) medEdgeCount <- 5000L bigEdgeCount <- 260000L nodeCount <- 2000L bigSymMat <- randSymAdjMat(nodeCount, bigEdgeCount) medSymMat <- randSymAdjMat(nodeCount, medEdgeCount) bigMat <- randAdjMat(nodeCount, bigEdgeCount) medMat <- randAdjMat(nodeCount, medEdgeCount) dim(bigSymMat) dim(medSymMat) @ This document surveys the runtime performance of graph operations believed to be heavily used for common bioinformatic analyses. We use two \Sexpr{nodeCount} node graphs, one with \Sexpr{medEdgeCount} edges and the other with \Sexpr{bigEdgeCount} edges. Both graphs are generated randomly. <>= matDim <- dim(bigSymMat) cntZero <- sum(bigSymMat == 0) cntNonZero <- sum(bigSymMat != 0) pctNonZero <- sum(bigSymMat != 0) / nrow(bigSymMat)^2 @ \section{Timing of Operations} Here we look at the time to construct \Rclass{graphAM} and \Rclass{graphNEL} instances using two adjacency matrices with the same node count, but different number of edges. \subsection{Creating new graph objects} First, we look at the \Rclass{graphAM} representation. We construct directed and undirected graphs with different numbers of edges for the same node set. <>= ## undirected ans <- timeRow(graphAM(adjMat = bigSymMat, edgemode="undirected"), "new") df <- ans$row ans <- timeRow(graphAM(adjMat = medSymMat, edgemode="undirected"), "new") df <- rbind(df, ans$row) ## directed ans <- timeRow(graphAM(adjMat = bigMat, edgemode="directed"), "new") df <- rbind(df, ans$row) g1 <- ans$result ans <- timeRow(graphAM(adjMat = medMat, edgemode="directed"), "new") df <- rbind(df, ans$row) g2 <- ans$result ## using a from/to matrix ftmat1 <- t(edgeMatrix(g1)) ans <- timeRow(graphAM(adjMat = ftM2adjM(ftmat1), edgemode = "directed"), "new f/t") df <- rbind(df, ans$row) ftmat2 <- t(edgeMatrix(g2)) ans <- timeRow(graphAM(adjMat = ftM2adjM(ftmat2), edgemode = "directed"), "new f/t") df <- rbind(df, ans$row) rownames(df) <- NULL df.AM.new <- df df.AM.new @ For \Rclass{graphNEL} we can use the \Rcode{as(matrix, "graphNEL")} coerce method for the undirected case. For a directed graph, we convert the adjacency matrix into a from-to matrix using \Rcode{t(edgeMatrix(g1))} and then use \Rfunction{ftM2graphNEL}. <>= ans <- timeRow(as(bigSymMat, "graphNEL"), "as(m, NEL)") df.NEL.new <- ans$row ans <- timeRow(as(medSymMat, "graphNEL"), "as(m, NEL)") df.NEL.new <- rbind(df.NEL.new, ans$row) ftMat1 <- t(edgeMatrix(g1)) ftMat2 <- t(edgeMatrix(g2)) ## there's a bit of an inconsistency here ## since we aren't using the node labels ans <- timeRow(ftM2graphNEL(ftMat1), "ft2NEL") df.NEL.new <- rbind(df.NEL.new, ans$row) ans <- timeRow(ftM2graphNEL(ftMat2), "ft2NEL") df.NEL.new <- rbind(df.NEL.new, ans$row) rownames(df.NEL.new) <- NULL df.NEL.new @ Here are some notes on the \textit{experimental} \Rclass{graphAM2} class that uses a bit array (backed by a raw vector) to store an adjacency matrix. First, we make a more standard from/to matrix: <>= ft1 <- matrix("", nrow = nrow(ftmat1), ncol = ncol(ftmat2)) ft1[, 1L] <- nodes(g1)[ftmat1[, 1L]] ft1[, 2L] <- nodes(g1)[ftmat1[, 2L]] ft2 <- matrix("", nrow = nrow(ftmat2), ncol = ncol(ftmat2)) ft2[, 1L] <- nodes(g1)[ftmat2[, 1L]] ft2[, 2L] <- nodes(g1)[ftmat2[, 2L]] @ <>= ans <- timeRow(GraphAM2(from = ft1[, 1L], to = ft1[, 2L], nodes = nodes(g1), edgemode = "directed"), "GraphAM2") df.AM2.new <- ans$row gbit1 <- ans$result ans <- timeRow(GraphAM2(from = ft1[, 1L], to = ft1[, 2L], nodes = nodes(g1), edgemode = "undirected"), "GraphAM2") df.AM2.new <- rbind(df.AM2.new, ans$row) ans <- timeRow(GraphAM2(from = ft2[, 1L], to = ft2[, 2L], nodes = nodes(g2), edgemode = "directed"), "GraphAM2") df.AM2.new <- rbind(df.AM2.new, ans$row) gbit2 <- ans$result ans <- timeRow(GraphAM2(from = ft2[, 1L], to = ft2[, 2L], nodes = nodes(g2), edgemode = "undirected"), "GraphAM2") df.AM2.new <- rbind(df.AM2.new, ans$row) rownames(df.AM2.new) <- NULL df.AM2.new @ \subsection{\Rclass{graphAM} to \Rclass{graphNEL} conversion} Convert from \Rclass{graphAM} to \Rclass{graphAM}. <>= ans <- timeRow(as(g1, "graphNEL"), "as(AM, NEL)") df.AM.to.NEL <- ans$row gnel1 <- ans$result ans <- timeRow(as(g2, "graphNEL"), "as(AM, NEL)") df.AM.to.NEL <- rbind(df.AM.to.NEL, ans$row) gnel2 <- ans$result rownames(df.AM.to.NEL) <- NULL df.AM.to.NEL @ \subsection{Size comparison} <>= objType <- sapply(list(g1, gnel1, gbit1), class) Size <- sapply(list(g1, gnel1, gbit1), object.size) data.frame(class=objType, size=Size) @ \subsection{intersection and union} Currently, intersection and union are implemented for the \Rclass{graph} super class using the \Rmethod{nodes}, \Rmethod{edges} methods and constructing a new \Rclass{graphNEL} for the result. This is suboptimal for \Rclass{graphAM} objects. %% TODO: evaluate intersection/union of two random graphs with same %% edge counts as well as the mixed size case <>= ## interesting to note that intersection and union ## are returning graphNEL, even when input is AM ans <- timeRow(intersection(g1, g2), "intersection AM") df.setOps <- ans$row ans <- timeRow(intersection(gnel1, gnel2), "intersection NEL") df.setOps <- rbind(df.setOps, ans$row) ## intersection2 is giving me ## INTEGER() can only be applied to a 'integer', not a 'double' ## ans <- timeRow(intersection2(g1, g2), "intersection2 AM") ## df.setOps <- ans$row ## ans <- timeRow(intersection2(gnel1, gnel2), "intersection2 NEL") ## df.setOps <- rbind(df.setOps, ans$row) ans <- timeRow(union(g1, g2), "union AM") df.setOps <- rbind(df.setOps, ans$row) ans <- timeRow(union(gnel1, gnel2), "union NEL") df.setOps <- rbind(df.setOps, ans$row) ans <- timeRow(graph:::edge_set_intersect(gbit1, gbit2), "AM2 I") df.setOps <- rbind(df.setOps, ans$row) ans <- timeRow(graph:::edge_set_union(gbit1, gbit2), "AM2 U") df.setOps <- rbind(df.setOps, ans$row) rownames(df.setOps) <- NULL df.setOps @ Next we explore some different approaches to thresholding a graph's edges based on edge weight. Below we add random edge weights to a new graph object \Robject{gw} with the same structure as \Robject{g1}. <>= ## creating with edge weights gw <- g1 edgeDataDefaults(gw, "weight") <- 1L W <- abs(rnorm(numEdges(gw))) ## there should be an easier way to do this. ## sadly, it might be easier to extract the matrix ## and set weights on the matrix and create a new graphAM st(emat <- edgeMatrix(gw)) eFrom <- nodes(gw)[emat[1L, ]] eTo <- nodes(gw)[emat[2L, ]] ## setting edge weights for all edges st(edgeData(gw, from = eFrom, to = eTo, attr = "weight") <- W) ## extracting all edge weights st(ew <- edgeData(gw, attr="weight")) @ First approach is to pull out the raw adjacency matrix with values representing edge weights, perform the thresholding via matrix assignment and convert back to a \Rclass{graphAM}. <>= ## edge thresholding. st({ c1 <- function() { M <- as(gw, "matrix") idx = (M > 0) & (M < 0.3) M[idx] <- 0 graphAM(adjMat = M, values = list(weight = 1L), edgemode = "directed") } ewt1 <- c1() }) ewt1 @ Another approach is to extract the edge attributes, identify the edges to be removed (unfortunately, this requires string parsing) and then calling \Rmethod{removeEdge}. <>= st({ c1 <- function() { ew <- unlist(edgeData(gw, attr = "weight")) toRemove <- names(ew[ew < 0.3]) fromTo <- do.call(rbind, strsplit(toRemove, "|", fixed = TRUE)) removeEdge(fromTo[, 1], fromTo[, 2], gw) } ewt2 <- c1() }) ewt2 @ \subsection{Node permutation} Here's one way to permute the node labels of a \Rclass{graphAM} object. <>= permNodesAM <- function(g) { m <- g@adjMat colnames(m) <- sample(colnames(g@adjMat)) graphAM(adjMat = m, edgemode = edgemode(g)) } @ <>= ans <- timeRow(permNodesAM(g1), "permNodesAM") df.node.perm <- ans$row ans <- timeRow(permNodesAM(g2), "permNodesAM") df.node.perm <- rbind(df.node.perm, ans$row) rownames(df.node.perm) <- NULL df.node.perm @ \end{document} graph/inst/doc/0000755000175000017500000000000014136072220013224 5ustar nileshnileshgraph/inst/doc/MultiGraphClass.R0000644000175000017500000002053314136072214016417 0ustar nileshnilesh### R code from vignette source 'MultiGraphClass.Rnw' ################################################### ### code chunk number 1: loadGraph ################################################### library(graph) ################################################### ### code chunk number 2: creategraphBAM ################################################### df <- data.frame(from = c("SEA", "SFO", "SEA", "LAX", "SEA"), to = c("SFO", "LAX", "LAX", "SEA", "DEN"), weight = c( 90, 96, 124, 115, 259), stringsAsFactors = TRUE) g <- graphBAM(df, edgemode = "directed") g ################################################### ### code chunk number 3: nodeAndWeights ################################################### nodes(g) edgeWeights(g, index = c("SEA", "LAX")) ################################################### ### code chunk number 4: addNodeEdge ################################################### g <- addNode("IAH", g) g <- addEdge(from = "DEN", to = "IAH", graph = g, weight = 120) g ################################################### ### code chunk number 5: removeEdge ################################################### g <- removeEdge(from ="DEN", to = "IAH", g) g <- removeNode(node = "IAH", g) g ################################################### ### code chunk number 6: subGraph ################################################### g <- subGraph(snodes = c("DEN","LAX", "SEA"), g) g ################################################### ### code chunk number 7: fromTo ################################################### extractFromTo(g) ################################################### ### code chunk number 8: loadData1 ################################################### data("esetsFemale") data("esetsMale") ################################################### ### code chunk number 9: dataFrames ################################################### dfMale <- esetsMale[["brain"]] dfFemale <- esetsFemale[["brain"]] head(dfMale) ################################################### ### code chunk number 10: creategraphBAMs ################################################### male <- graphBAM(dfMale, edgemode = "directed") female <- graphBAM(dfFemale, edgemode = "directed") ################################################### ### code chunk number 11: bamIntersect ################################################### intrsct <- graphIntersect(male, female, edgeFun=list(weight = sum)) intrsct ################################################### ### code chunk number 12: removeEdges ################################################### resWt <- removeEdgesByWeight(intrsct, lessThan = 1.5) ################################################### ### code chunk number 13: updateColor ################################################### ftSub <- extractFromTo(resWt) edgeDataDefaults(male, attr = "color") <- "white" edgeDataDefaults(female, attr = "color") <- "white" edgeData(male, from = as.character(ftSub[,"from"]), to = as.character(ftSub[,"to"]), attr = "color") <- "red" edgeData(female, from = as.character(ftSub[,"from"]), to = as.character(ftSub[,"to"]), attr = "color") <- "red" ################################################### ### code chunk number 14: loadRBGL ################################################### library(graph) library(RBGL) ################################################### ### code chunk number 15: createDataFrames ################################################### ft1 <- data.frame( from = c("SEA", "SFO", "SEA", "LAX", "SEA"), to = c("SFO", "LAX", "LAX", "SEA", "DEN"), weight = c( 90, 96, 124, 115, 259), stringsAsFactors = TRUE) ft2 <- data.frame( from = c("SEA", "SFO", "SEA", "LAX", "SEA", "DEN", "SEA", "IAH", "DEN"), to = c("SFO", "LAX", "LAX", "SEA", "DEN", "IAH", "IAH", "DEN", "BWI"), weight= c(169, 65, 110, 110, 269, 256, 304, 256, 271), stringsAsFactors = TRUE) ft3 <- data.frame( from = c("SEA", "SFO", "SEA", "LAX", "SEA", "DEN", "SEA", "IAH", "DEN", "BWI"), to = c("SFO", "LAX", "LAX", "SEA", "DEN", "IAH", "IAH", "DEN", "BWI", "SFO"), weight = c(237, 65, 156, 139, 281, 161, 282, 265, 298, 244), stringsAsFactors = TRUE) ft4 <- data.frame( from = c("SEA", "SFO", "SEA", "SEA", "DEN", "SEA", "BWI"), to = c("SFO", "LAX", "LAX", "DEN", "IAH", "IAH", "SFO"), weight = c(237, 60, 125, 259, 265, 349, 191), stringsAsFactors = TRUE) ################################################### ### code chunk number 16: createMG ################################################### esets <- list(Alaska = ft1, United = ft2, Delta = ft3, American = ft4) mg <- MultiGraph(esets, directed = TRUE) mg ################################################### ### code chunk number 17: cities ################################################### nodes(mg) ################################################### ### code chunk number 18: DeltafromSeattle ################################################### mgEdgeData(mg, "Delta", from = "SEA", attr = "weight") ################################################### ### code chunk number 19: nodeData ################################################### nodeDataDefaults(mg, attr="shape") <- "square" nodeData(mg, n = c("SEA", "DEN", "IAH", "LAX", "SFO"), attr = "shape") <- c("triangle", "circle", "circle", "circle", "circle") ################################################### ### code chunk number 20: nodeDataVal ################################################### nodeData(mg, attr = "shape") ################################################### ### code chunk number 21: edgeDataVal ################################################### mgEdgeDataDefaults(mg, "Delta", attr = "color") <- "red" mgEdgeData(mg, "Delta", from = c("SEA", "SEA", "SEA", "SEA"), to = c("DEN", "IAH", "LAX", "SFO"), attr = "color") <- "green" ################################################### ### code chunk number 22: mgEdgeDataVal ################################################### mgEdgeData(mg, "Delta", attr = "color") ################################################### ### code chunk number 23: subsetMG ################################################### g <- subsetEdgeSets(mg, edgeSets = c("Alaska", "United", "Delta")) ################################################### ### code chunk number 24: intersecmg ################################################### edgeFun <- list( weight = min) gInt <- edgeSetIntersect0(g, edgeFun = edgeFun) gInt ################################################### ### code chunk number 25: intersectWeights ################################################### mgEdgeData(gInt, "Alaska_United_Delta", attr= "weight") ################################################### ### code chunk number 26: loadData ################################################### data("esetsFemale") data("esetsMale") names(esetsFemale) head(esetsFemale$brain) ################################################### ### code chunk number 27: createMultiGraphs ################################################### female <- MultiGraph(edgeSets = esetsFemale, directed = TRUE) male <- MultiGraph(edgeSets = esetsMale, directed = TRUE ) male female ################################################### ### code chunk number 28: graphBAMs ################################################### maleBrain <- extractGraphBAM(male, "brain")[["brain"]] maleBrain femaleBrain <- extractGraphBAM(female, "brain")[["brain"]] ################################################### ### code chunk number 29: edgeDistance ################################################### maleWt <- bellman.ford.sp(maleBrain, start = c("10024416717"))$distance maleWt <- maleWt[maleWt != Inf & maleWt != 0] maleWt femaleWt <- bellman.ford.sp(femaleBrain, start = c("10024416717"))$distance femaleWt <- femaleWt[femaleWt != Inf & femaleWt != 0] femaleWt ################################################### ### code chunk number 30: nodeAttr ################################################### nodeDataDefaults(male, attr = "color") <- "gray" nodeData(male , n = c("10024416717", names(maleWt)), attr = "color" ) <- c("red") nodeDataDefaults(female, attr = "color") <- "gray" nodeData(female , n = c("10024416717", names(femaleWt)), attr = "color" ) <- c("red") ################################################### ### code chunk number 31: nodeSub ################################################### resInt <- graphIntersect(male, female) resInt graph/inst/doc/graphAttributes.R0000644000175000017500000000766014136072220016530 0ustar nileshnilesh### R code from vignette source 'graphAttributes.Rnw' ################################################### ### code chunk number 1: exampleGraph1 ################################################### library("graph") mat <- matrix(c(0, 0, 1, 1, 0, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0), byrow=TRUE, ncol=4) rownames(mat) <- letters[1:4] colnames(mat) <- letters[1:4] ################################################### ### code chunk number 2: exampleGraph2 ################################################### g1 <- graphAM(adjMat=mat) ################################################### ### code chunk number 3: foo ################################################### if (require("Rgraphviz")) { gn = as(g1, "graphNEL") plot(gn, nodeAttrs=makeNodeAttrs(gn, shape="circle", fillcolor="orange")) } else { plot(1, 1, main="Rgraphviz required for this plot") } ################################################### ### code chunk number 4: edgeDataDefaults1 ################################################### edgeDataDefaults(g1) ################################################### ### code chunk number 5: edgeDataDefaults2 ################################################### edgeDataDefaults(g1, "weight") <- 1 edgeDataDefaults(g1, "code") <- "plain" edgeDataDefaults(g1) ################################################### ### code chunk number 6: edgeDataDefaults3 ################################################### edgeDataDefaults(g1, "weight") ################################################### ### code chunk number 7: edgeData1 ################################################### edgeData(g1, from="a", to="d", attr="weight") edgeData(g1, from="a", attr="weight") edgeData(g1, to="a", attr="weight") allAttrsAllEdges <- edgeData(g1) weightAttrAllEdges <- edgeData(g1, attr="weight") ################################################### ### code chunk number 8: edgeData2 ################################################### edgeData(g1, from="a", to="d", attr="weight") <- 2 edgeData(g1, from="a", attr="code") <- "fancy" edgeData(g1, from="a", attr="weight") edgeData(g1, from="a", attr="code") ################################################### ### code chunk number 9: edgeData3 ################################################### f <- c("a", "b") t <- c("c", "c") edgeData(g1, from=f, to=t, attr="weight") <- 10 edgeData(g1, from=f, to=t, attr="weight") ################################################### ### code chunk number 10: edgeData4 ################################################### edgeData(g1, from=f, to=t, attr="weight") <- c(11, 22) edgeData(g1, from=f, to=t, attr="weight") ################################################### ### code chunk number 11: edgeData5 ################################################### edgeData(g1, from="a", to="d", attr="code") <- list(1:10) edgeData(g1, from=f, to=t, attr="weight") <- mapply(c, f, t, "e", SIMPLIFY=FALSE) edgeData(g1, from="a", to="d", attr="code") edgeData(g1, from=f, to=t, attr="weight") ################################################### ### code chunk number 12: defaultNodeData1 ################################################### nodeDataDefaults(g1) nodeDataDefaults(g1, attr="weight") <- 1 nodeDataDefaults(g1, attr="type") <- "vital" nodeDataDefaults(g1) nodeDataDefaults(g1, "weight") ################################################### ### code chunk number 13: nodeData1 ################################################### nodeData(g1, n="a") nodeData(g1, n="a", attr="weight") <- 100 nodeData(g1, n=c("a", "b"), attr="weight") nodeData(g1, n=c("a", "b"), attr="weight") <- 500 nodeData(g1, n=c("a", "b"), attr="weight") nodeData(g1, n=c("a", "b"), attr="weight") <- c(11, 22) nodeData(g1, n=c("a", "b"), attr="weight") ################################################### ### code chunk number 14: other ################################################### ## We need to reconcile this #g2 <- as(g1, "graphNEL") #edgeWeights(g2) graph/inst/doc/clusterGraph.R0000644000175000017500000000245314136072215016022 0ustar nileshnilesh### R code from vignette source 'clusterGraph.Rnw' ################################################### ### code chunk number 1: clustering ################################################### library("graph") library("cluster") data(ruspini) pm <- pam(ruspini, 4) cG <- new("clusterGraph", clusters = split(names(pm$clustering), pm$clustering)) nodes(cG) ################################################### ### code chunk number 2: kmeans ################################################### library(stats) km = kmeans(ruspini, 4) cG.km = new("clusterGraph", clusters=split(as.character(1:75), km$cluster)) inBoth = intersection(cG.km, cG) ################################################### ### code chunk number 3: clusterGraph.Rnw:95-106 ################################################### d1 = dist(ruspini) dG = new("distGraph", Dist=d1) rl = NULL j=1 for(i in c(40, 30, 10, 5) ){ nG = threshold(dG, i) rl[[j]] = connComp(nG) j=j+1 } ################################################### ### code chunk number 4: howmany ################################################### sapply(rl, length) ################################################### ### code chunk number 5: somecomps ################################################### dr = range(d1) rl.lens = sapply(rl[[4]], length) graph/inst/doc/clusterGraph.pdf0000644000175000017500000025575714136072215016413 0ustar nileshnilesh%PDF-1.5 % 5 0 obj << /Length 1947 /Filter /FlateDecode >> stream xڽYKo60d4֊EIE.Ф{A2,r(X!97W,Tkvt\XSĥ)SKy\˼Zh'i!z q}A ޵7޸yʩ:-?{{˅Rqe-NXft%w5X,WF Y^iEb3P&NE+q(J~?d'8GOvOEV[,VZE¾TQYtBx!U&LlS m `XC\ޭ$*mNӜ``;\]=܁9re>è@E_G3+@/3=yi`ʞ(05u 'RB0ل@@rKN>̌U?dÑ"Cjcs"^xa2k ~!B{Ks;VGn:64pz=un[:˖6(힗)sZwx\RFa4a^3N qPB+/DQ(cy6CPG(R=B5Dt:Xz&qauuOF05Ma:iZ2Լgv5zrK=(I &^Qz"yօ.}#ʀZtmsp[dtD&td*qfQJ2ގc`x{I kug&< y\q1 B{-0y8p}h#>(e0hʬ! X3vn$zcE,m@]@Vsf=X3۬Vux^zaaZ#l@bIS2 I2lLtVݯ%oѱ7ɯ=vIG,r8N=iGH7wɦ eR䓟IS+f  XԹۤ flzVK6Ѳa=Y18lzVv;4tHpU:.iyY]~n^x|XsʿwLLyG!Hzl>MÂx^0;lpῐiq55fz o Xk[Ot~&ܽXTbrY?ͬvgb/g}7J$d$L}J?Y)+B)IKZbĨe IVrI*$if}:X&~bY^*^*^*^*cFZoFZo&32g$<# /2 /2 /28>gLZo^=+cJxV³g%<+Y Jx\\ZKsi}.؛&7~s}qbEiY%>j|".^MRn0x$,gAr<$qi`-h=%_it tDa2 5Vst-G/ $ȟߑ ~q1vl ^Pc\卨 ޹'#AiĹi\h~o?{o+ endstream endobj 20 0 obj << /Length 938 /Filter /FlateDecode >> stream xڅVKo@W@)]އG"UU{qC vݴI ;7/.n8T;G'+Edrf ]x]v,XyW7SES _ s[y~3ww$M7}Sq9r9na kQc!7l=펾(*kַ[njXŮ%tȈD$g@hDZr<)62bEn[ArW TP$ +C%6 g~G)w"BE4dɜ3Fx roq;yYˀ=aoֲt, Y:n':ɞx+AV}+zKѹ|#kB3)Ql>×>zޙ%)bF0~ESRMxG54a'qn%m сmur˝,잖m\5 `FO /Ǫi'\ıHv^#lx?tƪrc*: Zvg~vҗ}dReە [C{j}dInLSTpA2b> stream xڍT6Lw "C %ҝ00C7JIHHwwKJ*%H4( {}oZ3yYD!i!.@Nna̓Ĥ uA60B?  !N(@^_( W I rZT9J8Iqy_K 9($$' iqAp*b#h!PQڸ8sqs9NP&n d3N& /<`P0 86h) U `}6 'tg&$` [0@MNÅ[ 7xS9 '=4w{`'33E4, FC.8듁:Ap￁ni KW.8(wȃ ?6k [8 `ڞ??|& P+3 pqrzXB. 53/pNPߟLe<~$Ute>)) r?l/ou2BU`{8ADn ~?KODɹ`,7 ;A.xAZ)}.1[}Pg9RK+u~ #|{x8yRFX0>~ p |DK 8Cs+B.#!?H7]+?p|B\.uh`W'W㏨N_x@83HmMPE$;ڐ8Ӛ^sOW ?p:L$_e9}9K{Trsc9ւ3=B3-YMCϭjrS z.Ʌyҹ5ʸ7c:EL9)1\8hX<'NƉibp|w"y D]~Z(qnd4A=%}-D>]\Cl*S }lЗʺ)J8TH۳iN0]+3fZ,LVq }fOo.ohb->u6Ϩe0 b_J.1 S-.銚=WO){_:2GRB1Hh J־g."_O>_I8p͐dm,£7$M&H쓩 qp96| /kSd?Bɞ}q,V(m ջ =Z1RTװ1_Z/ч3ZGg8^hV (n>5IdXw:$`[{:4d7ai/A~4oRK>auLׯNQGr/0;s]DkyF),)ol`,\_oDD7oCTys}xZ Q`Ge#]Y8YK=~P1B)?)]szp䘏~tzI[IMDx˭|#yA&O  trȴ3Eǚ\0⥫ޞ07 a x-D[$T7ܔY nAiZa=Ɋz}3wB#c~_{T<]6ab(; d!37}.> lU?+EBNk$q~4]s)h*GN>KOmmXōPq^0ZȜj)g]VQ22w0=J9uɚ>1hV}Q+d?f!#0K~! f<K|t;gr<5`gbNo{AD=) jV>c,O5΃bތP& o^mCs޻^D>t'm;=;5կ]ɰ#y֧n-v/cX+7{G6 @hQ^YEޱH'4cq~mcjn%FaDP?vx/μ-"^P6މ3ed}K&VYjIS'>=kN]+UBgB]~'a^Y+5SgVl$(39Zۂq26.0Tgw/G.`k6{yU|+^>z1&9P t?\[c:U_K2(;nvG"j, b4`ht^Qi ۢrc"]Dz%n=3o{Cdx2W&??6ᒺg B]Hŝk a^c.=o)ڹc&Fk%>G劉(ɽ6;blw2'ϻ:ar.Sm~X OBٚ~E8 xw/ >Y^ygjjw{]\F}$?Sԋ+JX5hjû+FGiР^ꚮ4şDtخt~8iv7Na4mn=S:J tC4,nᨽQ$UZjD )X9MIh U(̖QSVjbcpЌnPVciP}%P0F(=:3I zӳVEP>dD?VS`b2cDH9޻[$\ K|IQFߕ{ȷz[НdP_qoBTҪ]r<+eX߫ )I;`Rk₆ZLV{T5.JK֯!Y 8 J;LfC„|ܫAW֯xnVL_lG<ϴ֨$;fN@@']?uyԔ*c7J2:9 ɞ]<7>`beuPJ&X\ eS]~<͋," fF˃~>H.LUVb^b[QвmG\EN4`yު=._mrjɡ(_(@ Caj~xȎوmK.ZB_6~iJi[ ˑYve"iQЇʂ+#f-wIIc<󐭻8~|dou18 {V*2ľ93F5˦|KP|Ez+;ǹk]?vf )rl4Ҙļ|?<<2A"H#SSO$y|Pؑ]^Ԩ{8QDh)ty`sTЁ!a LYeFXOIVn&F-PU zm6a&Π*9aÞGqKPmiHP>,s&]Agcx] 5Ȃ致MI7~%&삪3߾b?bPLȚ()*+ќ*] Cmj'#.q?m>#=㐐U+bb2=B **Ʃ:m.QR8 4όiƃ7c>籃%iyD}\~k=T8x=U@VExߺ6l8URH8*#G {:?ü-\HPNsH=`qaJsIH$J"'L晚h̪?6|伎e/"}#fN jg3 ՠ }wl.%FV9wC>䊭x2fY20 )Ibw[o*;34IY5>R])P(,_/<,/7s "ʶ)DV8%!I3 `NYl '|ۄwΩ.LNıcF+r^(* "2ثJԿSƋ%Z(+̇oN s5cL5+ ?zAdH&TO݌CXPJ^$cIpSgPUsLMmS4R'a蘒a7pX O?sLZ)n'm5a) ѹ&eʰ!"qʊTư 7V֋f km|=ZgaN*rzfn LNX_[%NVL - LP `Y` 79Ďmdz:k}S$B*4bPLG\B$ldit93v>T[DݜkpR7]gRvb ܔ^ ӏr"fuD\EqhLWbD ^r&*$y%@bh_ Pa#\#eQ,x* K`u$cgN[V'TѴ% 6nyy\hHV!VۮYY(7&sDՋ?+p^]^3P6&ZmaVc?L#ch$u|Oϐ'˳=n)z-!dD0uHJ(b-`1dsDڵi5GYIn/~}8hwbVY?{[t ha?Ԙ H|d͡wݴhb"&-YveLkY]MdwF\GDZd7yQ5Ekb,my쾳y΋^E`n-=$*1r1|:01)N +rژ€hkKcFl[i_9{="QqTCpx^.h{ĵd`+E[L{ VqxɡNܟ4M 򪘓u^Z.t=p:{09QIws٠ 3Ywq[DJBឲ(ITozq|A1.~֩٠+6$\ P~/@b=bNX=]LAC[ LO+⃙{9od9>Ga ȗ]c/_VwT/mcwb.Y D<}C7B0+/r(s{ktUDǹ1pפɨ#AYqcOn+O׎M8IwK\3^D͋Sg1| >lnhDmT$zٕ[r3?) J~ceHףIwsB1≱˚͉EW+3Oy]1Ǟ.>ANĵ01(tq"D+KuP`x"wHⶏ3X34%YM\,-eT&GFm(Wɫ$e?k#S6, LBqk >P @ )ޙwcgY*= c-Pf: endstream endobj 32 0 obj << /Length1 2067 /Length2 16813 /Length3 0 /Length 18069 /Filter /FlateDecode >> stream xڌpk.'Ğc۶m;Ll۶Llcb{bMll|UTWu?ҽy%cC# -='@HF@ODKOKBlh [ K w0=C&la'cc t00X98chc 6p67$m$B6nf#܈F;@ hond` 1p4Z}hd` P12:Wrn3GG[N::Z+Z{S^ j@w 5Ōlf\X><J9[_P ?#FF6Vn֦sK @NTՑ``m͇D`don@`nE?|TYX hG~@Y kk$lT휀|`,lLjdFGxe7[J? cdl>ZZJ8|,h j 47w42kZe@y?Gkc,>S؜>Rcda~4<>vhm?\&6t@'OF1AL:N?@bЩq| ;?#ǝa3/3~(MP0fCodp&Gl>n,>do-?[ ~PWDj?̇?fq[[M2-k%#cmUg* OP:|\N?"cG:.6r/Qr.jc/AO_kadAϋcg7`l?|uٟ%WKXpzNߴHE\!_8imiKP8vi }O84<_M!x,QR6]:e1\1ºy|a/7 Hue/UϞP^c-DpN[ L;`ىoKs }pJHnZ1 V*gn dXPz9 R a;=&;d8KeWelҢ N{aWw,3&` 2:`\@V%:ptq!XbH۷G3J, {#h&9wuюlT/*]BG:}s"w>* :X5 )AυJfwffǽq 5^ʉ9]E<Aܱnz oD{W3V޽D[~y} /lM+G gM>}H:!=xbE5بAXv,*9|YpjJ<1SE MƖV7pb$aKj|4Ѱ=^r+[})>-7d2eї/]%|RFc?ﷵ/Ls+IJw<[C)t$j'5j>"wPݎ@xj͉*] )}|F#/Ie6MY&JOl 0OL f)t؍޿{e+$SښEʅd:[g,~|]LacO.l4oiXM:L(تYm>{՚! r*$~ t^fm_ec'4/232l,K*n8r%uHkQxBT@v%x~e == 0C7)O8=57/n{2מּ幵0r 'ytY MLnxDiF22SbZVm?#E}>![=JV!TcqT)b!֔Wͱ6[ ;~F ugvHCL>@aiM"a ](VQu}R۾`%<$8_FSYz`bM0X7 ݱT&jr&P5(cd m}c_cwv:]&|庠qi&Q >L0 l0e`fv۸4ECRl|% 78.ni^#ͺECR̘߱辄dB6d.B4wx.O n)R:kk4e={(/iw% ܡQ,拐~QVH? B¤h|G4RqYl4S<"o(P2J/W9e ;%6C|U["edvA.tE<ǨvR4[`P(etBRYgH߭,RSHBRWQʲ5se˨C]Y^~`%z6)j*ŴZ/(v@%υK!O7*""/f#yA5'$I ޓ3J(I;_r&>biͭ6)]mYY'KJ'MV6zH6n^ZdnZ{KW|Wmx Ev9\kϜpÐJbo%~搄;x}e N~&Ր#m@H?VG9/z k-C STcbiɹ Rin.KϞ O#MT&Cn%zuU!97|s0P`!}X߭`WC0M] aaE?i)x_倥U>Z.U$|Or&MYWtQ\JXdu[o9!$kӋrM*؁E%Z(^d#res}^ssbHPL`-EL3)Qu3yG'%eVF,/gaڀ# tV,RljpOե p-jf((T4XFcG9P 9,)CBx<:_}D׳mHfZ fe4Jon,y ).<(i  ~irl؇8^ao!hhkɰh{yW~ZTXs&Wq\c)LD3w%@I! (~Y8ڻeLnnTF?e¶L63NƊv J*LdT^^[4t|IM wGȉÌLD=6EpM^H8/C! q*a8OnPK&c|di C~e\L8emUJL2g`%vVwGb>Hu9Ϥ.ߒى~VYƮJv'5b$'X/#>*7ouݿU+A;s)~s_vWpEU;즠y+i8C/25IbTNALbn F*41`Vl[J?2. xhQ=ɸ}u&E&P1lɖYvArQZ̉EO,q.rm+j|v9:TYI)1ṢLK9w{v%L&HN{}Wg5po8cV  HOhbQ)v ʾК+vzQ:䐊 DW*5P's1Ih sj7P!A ELۨ 8]xEgo( M2-}_@=!*~-6ꮰ~=v~7C.U=?9.]<_W^FkF |\~5AB[8D[S{W[i_G$"GHO}mzl:a ;݇RV1D6lz̧Ψ\">x3e' LU9|_?buul6X[Iᑇp"7ͣ~MIAi4g*"uɈôS}Jl+x08V, J~*y6Y6oչN [Y)hJ:y/'GQ cU1jt [t-v }#wfx¥92K(dCyG޽[’)mm^BÇp&`^\ᄳRwDqʹOدs p\i=_ĝX^Rɲ \Z9˾"8JAɽeګnbԴBR4Zf=t"jMr!R˒k*H\MLw)s/cȾA+rWP0R[`6in6Y]WU vz ՔmAӀR6]0h6-9il`zeDd{F7#, Jip=qPJ{6jz,3^8f/, eGQ)|r0E C2FTZjm7W`󅦕?V \-fSa*W>@3߫_zA %פlުWj_5,UZ%$D@U<RG&Wirbاp K}է euB ϔbƦZ\W+Tڗ(# G_{¨9g\g;SA[I !Fѹd$Vh LwohwOʐqt .1 }„5)_X2]AVPVQ8^kv%6?bʡ.vƁ\՚P3B:_JT-j=_ZP_N>[L {=‰pE AȦ̈u<< / 53)XÎQÛi ~4bv @FXna5;ܛ9D]$>䡸I6Re~Lr5Bvz9}ͧGHCTu)yXު~O6%8i>9`lx#R vgc`èNs#~=iy;Wiѵz V3a_ꚅjki_D=ŖP>eAn@g2lg4CGt-lEB sc:fhœWfS?PYb >fƗ l?3TGqO85R-;cZ n !|2[B$̵=" ӎ 3eF9oǹk-&mdrV=-2:D:AcV)م^{б|`cMjMCwx:-|c~܌ZyѸ+-w NS;Ʀ~J奇?*쒍}lZSl 5J"i. iXׯ2 6D ]Qֻ=xՁص`-^'T12N;Շ_ @:}UQ#y Zp[N0gO*e4H}F?NQyP *BŮSF)6fN#}|rNFSRLށ?m=|=e.;|,x$8XTBS0  22FaHQúȗɲV "6mA1iH5Y5XOyiyib? :Z1L` 6O=z͑ \FF0&|֡ C ^-o7xI4 $ ″Ӓ& AMT4(2c@>)/Tԡ6r/ry= gJ!*N6Ȍmʢgj& Fq.HǠ8K^ƯoQtWa+)qx&'k$T`c8@ᭀR%%%yޠ?K-p59(_yGdLWtBW`ly$Jp(k4 n; gC)A@_]xѠ|Ħ׸b=]t_kȲHL[hnH^$xJm`no*GJ8ek3J*J ؠ'O|-T9-?˙A*@d;'{ vBqR!{#В[/(fUJxIFFS.^t-|Bq]ZWѷ8+?Y Sj|cVÁ;;k1|As,' S!Wp%n&  ;.7TAW@1 1*H~DVu!z].^}b8)׉'vUP=\%"0h%Kge+-DC9.KȎ}̔bw3Qhv,EDa5_2=]+J"?@>e\E)5GZlXhXX H}aގͱ-`qYCɗt Xk[ȘE̲1gng{^ QVwL(JnW+Z3=l5v72fw,xҝ:Bvx W+ pǶ Mt&_}tv4a _'=Ņ H:%jVr3Zfq>i.p"j<%7(R CN.dʨ4I }H(JȤ ݁`cۻlH7Wm}_ꎳ48@xR]MJ5* 2:ت HV HIo.[Ѱp6IPΝ^0FraGc '>}&)B̬[fm)Coyih1XfϡundQ1Gx?u4Q!ҀI =35g[P/azʽf+H1:T !j7BӔG'V{˙׌҉5_e))tx~VhAGjн&;W9oHx$X.al}f=>BR $sͫLpNaTE0/cU;Dzoz1Fp7&x Usa(ҧD84`;ǽTע>Y[W#Hna]nA/Xe ? O`[=elE؄UX6g 5]@M[.rCzXG[ ўb U80:HଦM0*m4(smqF2Ru ;ugsLs7q2Ij7^.Qb }ܙ@t"ůʱ\!bWlz9d<l7;H@tpcZ?b-ٓmT4]7Ӝ@O`eZ *]b4-Yf7bj,Imˡw!$4й k,Q:j+A 8k+kć֌&S\:6=?D֯e MV٘/@BnOY;FC$ #TuV L(\j匹XF6铺pƒcU= Ꮅauh`NSS#.P95t<^skV*|Eq娣%wfrM2J3K`(gF)oZciWT@?Id&U\cSn]lM2Uqj IDy`8[5+9qdJ;dcWLIL~30y\؝T|1G?ԊezPHLWN:Sg+d4ȩdegIH)JTkG9;y볡QEiu{3eLE[Z2AFM5nED{%`iDHą HQvxe2nJAaaŎ16 zخ"K/Ie/z(Sr])2T8I~t\|TZM}N{`a]B?-x>"MI\l0lڅ8˟rh$MoxN<|BpzZV}2]|ɑMyp;zmܗr|;!"^/J-O1f˶V_K4%p᫗DHeJ[H6CtFr*xq{2d'OJJsz6A{PosXydlR *wCSmn=@N̑㕧lb=&t%AmlhڢRha)C]#hV1g_Y t_vJ-[-kn_$ G" j,M+=SnmBeg ~qz %auU;ʬ,>?PC㩵fK[F{5)#0HђXx1{9F)ÅsB]Li2bH>yfKUwm+1dxqU˨&vv =zrwo~ {xwFcJ(gCݫ7RsG:˘es,t=Y; _3 ]ܿ~TTP$#!ǥvRpb媆{X4<!&ſC\$6hzzӷ4y .O]*iDOx4̈*(P+q04mdqɁuޟI#Uyo:o= !RP m\a^O'̎k1]yעXOuՃ5Gm_5-,7p֍)xߪZYj B F4W⩏쬆f=9l;wRD;j3:%oi.ܘsUKh72H}o4>ᵖdtI:^("OώiTej,n؛ۛY* /߅)bᄙ:0/̵d\?%ڪ#\~jv?[#1 ~oȢ,;;N{i7)I[rVLKZب^9/#bjX<5#uX!IFYg*Q91;& H&gF0x'~c3bDi-,j<;~q%;sdFk=AMH({HtRm|m_IN@=z˚'e[B`* ~{}s\,x@[9ډ\;O+ŶkVv SmY}K 05MAP*:&G_\/9| @!\cF}~B[`WcR oKsB\ '3ߚ?eyw p 5%x[IuQP %[(l/XPnCyv#e怃eAMRmiVt{:FWɴ]'7[L&.b;ӇҔDTsg: dXgl&Q_r xgLpBz@K!r̗ǫm*k.\+WI}}GOkɆM5ݸwΘЕŅ]{#͠%;BpSN =h0;]SYqǗwj;I •g$n6?\xM9òwHAK;hL<_1uGf&ȡ>ońw{LN0dz"rI0,|'8'1ѹ֠ !|ݰALo`\4l7KtyKu9܁aY&aU,)=/VsF|am6U$(OE;e/Q8h5)bw?j" ˤ-v+/GN"HQ>Q*9M}?ai@D&hôO狭}k^ҍ2n1³y0#PvsK g擛ዺc#C.٣ՈBKݢR7nxt=+@7 .)$b+aN?_P Us*bv{8ƞ꺝 ^iB᱉Y+$63E@8R QU]Ѷ/? yUI{PPjă'!mь5#T|4~ w>_",0W,d> &K !ʈ J1zP&V3*[Xc9xPI=6@\c'auJ-\g/J$Ca,4N6)/ePy&iK*\eLt(b~ZQ|V6u{H(Jаh'ŵOe |Xer81m5F~bSE7$orc'l @yu9j.r+Ic _~24Itwov,p .Ҡ m QGh*L0_ $maE?Fb_'"})ɀ hk}蚷nanTeKхэ]VؙK+tZ*ph/ Ý`n/9c2\?=znW#m;tO;,nJ\f]"߷LnԊ9`g }ЕCO Ƈ]d?}~4:?s+Uv^,Y7i9نPԽm)2!=VjL$u7@k{iǝj5Ϝ&at?6<-7o~ܩȱ3?}h9i L(s<\R6H˔t'h='C,ܽVI>u|+9RM;x NG?tw&T9~Uāu&($H+,#q.tfpW, NS5џ ,\p19ŋ^z|*4(w 񬃸a~4osQ[<c^cv#?'QZg~x $[ > gJ\Œ&sP잩1-_dd1!u{@TߥN~jʄ~14 n01:(7i[ȷve\kdI6lڻ+ bSDYe endstream endobj 34 0 obj << /Length1 1533 /Length2 7526 /Length3 0 /Length 8546 /Filter /FlateDecode >> stream xڍTl6L#-ҵtw#݂ ˲)!-4)HJH(Jߪ<9wݝ{fkn6f}#>E;-D Ju @0?(f pg3 ݡpʧ@t0 @P (&%(.@H) jhaw|6e8 up@N0@PRRw8@A0: rPRp8zx Ap/0C^; WȟƎP?~#7 .P0掊A#MmCC5    sC] =5m~^frqA^ E]9h=w0pwjQWԔUavpWWW}*P$uaP&<&0'DS/ ʅ"v r:G{T@=<@m `- '; c. XQ}g khoLI  $%$@@࿳胠U'TfH)5s\҅D pG@Q %!-H7 W_f==PׁT3ȟՁA=]@jP>G,& ݡ^ ?jΨ8>R0!Q1QB V[~@#ݨ$@@%)Ba-7A (Y ᣢQȿMQR?@+2?_{"7FQ@| `Y8X:©.FΛo4ۖY7:/l y>swyCTaT׏ ''Ɵ}Qg3V`قީV)A_B~ݧS_45e]-b/$Qb4,8| w|HfNϦ oy&[|JXȽ{4 dJ;ZsekTci.;~[#kvq){4OZ5R\_0,khغ@o\E $ vp9)̹ )` 1[ ԫ+#+͒6 -!CwW}4gbv7](N1w;{la;5*AT_q.$ou$>pȠS9M1!ciNT9}>;d7S|G *WϢo+mA8N HbC%cXz8Ҝsɳ7nbA1E$?Iͦ SIQ]h:Ox[-ljB ?; nIUOz캘\Q1WXqD#s3],{;+^ u)ؾ a% b} #JIN紸!CYB?A/oEn(D8SeѿƘl 96x|ҽ䟌 0HeYIj,.|"rG~I^`2%Y;:+=MbRv \|&:]Smy[LSHSrn8KVKWj6d.jд}=3eH9ǫF0ƽI*Ĵ% 5"dfM~~psW6 9q;HȚ :&f6l$ ' !7ve8.#p1&ǧ]bg?4>0<uB+ 2ToxRnFm?ON'nQQ4'6TjG(>_FO19HivXfU'W̾¦GyTpB5[ 'Wȶx`$KbŪt&2;Vwyr>ֺ$<<ȸeBxƙۘ gK^1Qy>nN_ݥ!܊%{˥7C C~K9螘<9hA/-~,Θ(g{73bnp\,Eу.齼P/;Z6̙w65~ib9@ؕmJWCȆvi19܇E8EFU*v)kL*=2DE!ɫ1>ךezMb3EGF,F nq61k56Y5_(g[VPt?m/)UEA1rAckC؋jFawwƪR^uft(i/.~h-UpO))QԹҷ=KޭJbm,pq`g&ɰ#S}JTkbxuoūS1̽ܜ/ wyF9u>/0}(+۴~(M }Pc7%FP+Q.Vy7}mpru.d^>'LB۽k'\'zU~ib}7"TNLza'7D{gx4㒈ɡ-.65ܫg\!i=lr4tO&J-1C̳h/zj޶) WʁˏgR ؕԪϥ`if\w Z~0[[a6 6!0F",u4+9=gtACɋ%C9e5+(;m%fNﬡ~vu-n3o;>2n|]/Y}+B5zbI(6r12'#BjJD>Htx#X*k^㽷12|!q-Gʵ[A/5MjFT=|5aԄp#o "P{td,<oj68pF9KMۋP KsMecL6;b&/#7/Ƈ0;%ON ;jo2s)9 ݣk. E+!$5Fς jxɝ0WR2/p0lU,22HED$iPH& |QG4U I3Ю{"jSeh}(hgS ޖ6-䩫A Ԭ2\lcv,~;Ϲ()t_Ȋ9Ď>\>XNZW(ZN,Fh'n#,#qRdeZJ-3\àR[1x^ի7iHؒċ$4麈Y$b~?_0Xc@a|bQv >Fo4m#. xu.-to=)ë&>xՄ/Ŷu {B<+,k]8 83.$_Sg#xB'v.I*L%-B:D[ܐ5ᒹDN*̈,!e1No:IhnfvO8 w7 'V}lf:qFekbWhçs/so@fxw>\0)Ϊ;7>:ة\9h",6 [%;GW;|Q(&&2R3ȉM*yhXQ%];tR#;?zJK8GS4FEwfخ% Y9YV ?U\u/>0%u3b9F\vAs OIwƦ*ݟ"q*ܤ0%%} `+i?ZVy_VYmƬ66,PѶJv2eS$^\ kej0z0duF%, ׯxt|BSS=MOR~BW7La3# e|irSOE9_QNF~P(\OP!Ss{)+>kشñd|/O MubxvI+ 9mώg8 }Vﳯi[-jlI6WҟWHGeȹ/<):wpI,J?KWs'9~C,"S( hB%F*}޶6EĀ<}DMOV=9xN4tYJK{;m^%s<#7'4F6h|Q,^f]VZ9ZlT~I.`[G0Y(2%k0kP&;.τxXnǻȑW@I-pťo@wM %$Y)^=N{}[+nbE2gxzY@pذϯ*6c *hY+ 㔓av1iK'VXrЋT7:fq-tm0x'7z {n"_ L<:\}S]'{*_F^+U6On=?h9:6Y(H0y)sYcg a pZkuéHLvGUOsJ0/Ϧ>#B'_&P*mP<5{L=k1h;>-M `2A}f/򂵾k^45X*=G$we<|s}2GQ zUF }X_DzALV[A.H)9<OtܖUӟݬ2GB=V:E\soBjgL6gȰoi%Oftl+u`*ꥩ9C'n Re=jwk7_t36!^RĬ,:{[b?fVmcI]d*k^^+@X6 ɳ25vU8vS91X@Zߌ!L_=8JfiQ˦|A]"'xKpڤtR!i8%3 J(qne֪E܋}!EᑠQq8 ߽)ogG &;KȢǧA'񓭞Ԯ!m:XVѲ._и8VZQOVx`f`= BR$<D8VU1kީresu%7yi:M~bQT2 Z%R7 &Bp瑃Ɛv(:)$ Ic306 "K]?|+~&^W* "Y-'qb̓ЗE!{GP2/u8CEtmDQ# ˣ"ۉh=H Rz{QD7GW&? uy[ua !fXT˴SwO;"JE=6;He}"HY帉ʔߦj˖c endstream endobj 36 0 obj << /Length1 1613 /Length2 9071 /Length3 0 /Length 10112 /Filter /FlateDecode >> stream xڍP- ]KIp'&8 4ҍ45H -$wGf̽_^uU9ki_j0CL0 `cdac@AmQiN _@MmQ @ZL `_99N,N -ye):O4{vw?O q{,@`sM;۳jA@9ɿBM,P77Ytdm~bxn >z:PGgP 3(h lZx=vO2m |Y4t%o8 `fqqx͢j Rߟ> v zs)CE llf_J#OYo߂mmpM@/)60GGwTg!qps<ٟG,`9ܞ7Dy2M"߈ 7fߕ >A^? /L|___-/܁s Q3gG;?o4C] Y]W2o Mn3{.8;b"%Wf:^%}^ڔ]|kC mzuo>݊:?N7V'VKBƬ)KC6S5ڵGƭpڏʷ heZQiLf nXS9cOќEk173˟59:i.p'^{$y|nb2GEgzT Irr-0}Ǖ7"tDr`=.;52H7^3 S?a/+1/SQ⼙4 [K;~]UIYFk9Gqi[+1n]uԬݘvQuꭹ w}DWU)Wޖ6|Yba!7ݯ7ufv/w.6&VB\1%yg8 w\'*(X!aZ5J_Ww[tD0iP# jZ š3%S//xd "ԈpWǘci2~HAN/ޗljs ^[=dόpUpvՕm}nRi4qy̌ Df&LH? ma(܆w@V+~?)U_C"|O#Iy.xQ`opZc;83qOZ 1 L&r+ط4Ȱד7ńv쳑B B@atOM~Vya(|;1F6o{~19G{FΌQ/l0$8ߦKK4;ǂ!2'jfQ= YvQRia437ՍlC|xFs]32b헇XEZJ\u4W7NG&tܹ?qXX3M6^,j:5-~QLWN&އ/a6ozi4Fx.[ 5os C`HԟwàEpT\ae:9^q]~ }:l C!ijdƇΖ4gRlyN3}|{WӚeŐa\藙xR'^}1,NlOmպ۱`zѡt~%i&a䀡wkRKv#H1VAM:ڑՀ@++Ii]W0RSNM1/ Exj'Uw+pC G-('7K1Gw?ssB󷔑-Y[ faΓ\#F! m_Y7v#TyzWoSh ~Nl ]Pn)\018fn[#[ 2i2oP6 Uln>G;sS7p k0D0wo~9Gm<))fwU69wԻ+X 60_@+(z,hvnRM#\ɪо!)2ch0Y~xcS) ẛ²85QH/S^FYf0`bB0#}j»K!:Ye~׶L[5iw = tǞc|(#a`u֒9fGh?(=znP%qOG%wL) Fd` ҡ,8>+F$j- RΘm蒷 ^5lc>I4)*nRu .J\& )o +֦-cƹ)F (q" ;5,pϽ/rlC۬NՊ5fNhG%.y+vƆkR~k󡄋N0q<2/3![mXXd PmKwT_XMqXx4Iȷ1u6w<Syd\=IgZ2xSCr?)U.ʗѮ0'mI2xq( V{:Pv( ^ ^Y#0n5vVg!QCg>S*7]Ync%&nJDȯ49i?Y:>T,xN_M&eTᧀExwNfGR)B^0O*Čk[ t#lagTx%>R>T;2|!=fq~' V[Q تnq`mxm`;;Ax#(Zs72UJL]+TU7`0͝ev b{1*@:EN}'= h:U ?CJ,/ybɇƀ.,5RO!9~-z"Yk%C _]7 +E̤Hp)""uѶdQeHt A&pQ&BV4?uZ4 Kɵ‹#O_cUywdz\ζ-@s&w k}Eڙo1rQ]\zS4V47vU $EܷY[%/p<؂/Z ^''j|3_"VMlCqHu+§e$K~1)Ǽ biQD;(^zPL݌ ƍnXȒA0e81 vjSU'O ߏ JnhI8oml_6mOP'?${PFS~Xd2pߔ`wC ;cHZYJhTS+5J $K?:ٙzn 妏^.9[t!ۭ*(6[šf pbu=3)/}cC$4Z:[.~-b LȨhqY՚~$~jĹڐ2ǓrSYoz wC2I eEQ O:#2]kq WF"]f.~L(#>᠕\ʢ~axLC'Z^iRBhV߰?mI"|ͳF63 'ul@n}] ) эfzDO| ýGuy.z>7sAJ%:/,_g| 6uk5@R:sj5OM~&o650Ε3K&%Dה}#ͥw.x4-LuJ"6z#Gc6$N_U.H$53ٲ)iޣQ`?;ZfE TS<F0ld|~r B='.F =&kp-FU'{D}>8:e(vkF'h;WQ냒׾L3Va:k"vC):ֈMR7J/ N0/bʷb19C.L{I ־-|uL[ hȟ 5 f.T߲l6D\lJDbO@b_IP o^g%nh\q)!=NtQfks.SlFN-ϭ>Zm*A㐉.Sɲ ל,Uޫ'*QlPD~r|P ^U%&ݰ*B|1rHIQҗK0 7xǔMo*`2悘( x.?ӯ]jTb%x=-9'VVCGBcdƓM%zV; jrְk#M+s!rN??W`,C:.YPwXq~"eXQp{Ӽ3 +0j{|w[u҃3:\ "~;˽!J ZLfl[a9/Wω}^U FmI9Z'K}o)}=-t(Nœ +Kux] +hngTDF(ve5D#ThPzL;"6V:[ۆ~')+W@/@MXF㵱z}eZ-Z@Hג+N{糋@d$vx)MrL$:UĒbcƂ\( /N!qc^lZm_{4P3c8pE梸 "5&16Qr*|$;kr'y[&nݜwj:r%bvu&wӒ O@Nƪn^3j=vX93.X^^vVjnnǬEW..h8rSJB<6#5tjpSE>8J,lQґ-Zehvjb6𥵓ˇr8 2X,2dW:R{yu Pmt>A_v٭L0OރLME Mc0fy`+xUFnOhЬZ >P.ymWB dhm$6%mo ߎDKHR6+T0Z jU/KU񼸵H?7hM\5h;T%D2lےi>l6ō7 +>ANCρ.Q*5Szb>Q?C_ >$gϠ-pq„ۥz;denB{7Gm:36I{"nPlJVI~cD粃  u1'YUpaphq!/x3z[ 9Oi+`NOg׻Ғhkʔ0,O/.CP Pz4pHK?n(ϑw+Dٹ`ORˀG2p펦ɬ^$f8ImW+V?)ՀĬa-$,!BbĩN*j!K:,-\@ #iK-0&b@CJ3qZ&=ǮQhzBG['r1˜ݹa9f}^/mabd(t d4-G qy d#~Y[ WHi ~pq8C[EՓ^V)g~\k{(O(dޒs__x[.e%L**ؼbp鉗/㉔&̹ OƲCtz*Hm3?@w% nqُ2׉IkHBŁnS]vu0~+@U:([[x^|T7dw\[(@عL66-7s zoaD{o hHeG8/bV&,Nsb/FHE.ǡ .l at}5ŭ&)˧_nfL_Ew*j㜛A&WD(WB敩u2D)6uz[W٨ʎc{mԪMZymԄZ#b^J7ZPNjw`E_ 2j" <642ziĠҽf` nI.*k*ohDt][Cs'k' dM` H(I{c§{{OYАo*4vZWWvޔz6U*+*@aU#]k%7-(Xtt)iwW.Ĕo3{~ b1kֳү ]GE݉St hCv0Uο\=@j&V/pcNRg}HeNJK^L}wûEtD2g(2F,OaOڝX–BB3c#lOhFʥmclh X TDsPnCJF:[qaU Kgyr~QN L0 liǥ˿ =v#c,Y5!t|fpyi*G0& ~C ɩ.< ~1#4c|R4p 6溛=`h8jW؉zҜu=z;9s|^xWjɘ O(/fmO/pTE\>v^Nm Ic74(<ҮozOeH|@NSQ^d=V8FL BF47;=L19Ë%)#&$ps;,dEr(fYpU2c`1)y~`nڮ1L*ﰡtϺ!IA~5$; >ʝn6selJnc S;&`GrEURl6u3sz5^n4 .jG\;@t񖑵rv{.9Əy&ԙ*HRS&P'd{YمseV ZӸ_fx< ̫ڲSiPz(nRΥSbȮDj (}JǨ3M3bɤv,yS@U| `K!xWfXZ }ؠze I/Ō?p䬈|I"lawesř)aL=!0鷊q9DCHE>Bޮ"=DȮtv&ɃxwX8bY7ShC@)GWxh|P\"7H+)]-jU.tL'Ko=I=p0mYlX]7t}O*p5jPаڽ-X#'f T3 E?j +$CٯMRmĂ Gwv/dplrq 2I77d -QPC&1?CS≮<-G #AaGtVZ/ѲXэ밉mg/njI6$[c8[_h]y .}:el_J/,fh?n(eqNT"5gV׹|„Fھ vyާ`*σCQE|q<)q,~ZEUs@:t Ee3mG͢Zz^6}!|dv8tq!/Uu^ am~DQ`oZ4^>SAwvV Z:>j<]t 0_Ƀ5V. iU=tzΛ9Ķ>:TumE(!5p#25R: ,+83 O^^OW%c' ꢒ7}n9Sc\JM\x0 >9*gn7OaSNlS֨K\<H> stream xڍeT\NNpנ 4 ]w ns=9{=FwϪYTd*Lbf`4ޅ `e`feeGҰr QiH8.2I+UlsqظxYY쬬|%@7+3"3@lrF;x:YYXF_)/shPX^#m`S+tqqgaqwwg93,V.53 d]6@ h8f$**u; xZ_\@NuYoF`cf;hj s{Z[̭lAeifF7h ~l&TS3*Y~ymd;?I+'k=Y9b{lneof3WM{+GWX"?2 `A% lůuz;毥|A?H@7o"$66 daed7~'+Xg:gf`{[?EZE[CJ២Q=L&v7TVI_`69gh't~`ϼr~LsvA_u]]^A {AfVvW+|] 1{fc[l,m2Sr1kLk^;[+{ U`bce?]3yN_/u7)αsqNN@O$סbx.y0ۃ]^MNH"[7HAj2A\߫O4sB')d/1?lm@.G , ئ`VW[bg'gbx- lk t5 П&F`159s+?\`{|XX埼_c` Uf/) Oܯ5? ˿Be,?ɼr_yRGjб#duiX^O8_`'9V8]@f&j:۫_b{vFbqt׎ V }5k;@NH/ yLu5bL}ܚ?^\I9bl!zlJ 9ny%UF-!Cbxm;ބ`AD0 *\ N^G~:9'+K%,1 ' GHR^P|0OLJLYOnvSCX*\ח4rܽ2G }RwaB[9`!/ XKX4|GA)ģ pM*?coQ6ppGIF4w<.9)==5e5͘bR nh,eĢvšLXK ]ixC|Dǹ.hHCrZ FdX'heɞcy^ѩ$m<o;[ #if`ߴEO^ghC|T?J6J 1E}|9:PeAxV9 o2o0UȦH "{?aVhM ֞"1tRy'XuKY0Ĥ/;3Sğ@IWCMV 52MAt1_l{}aO?b;ӽ٩lPREOb!ìx>0eC=pm"b,.aq^5^'d(K)))};6r|8lG"oA$;Ou6ӔWK<ӳ( 9Ft 氡Lu>TҌ`&q;/ِUɿ\-Q Y~f)'yRנrz$ğ˃dW'x!0بD&Nl^=?Բ:\:t'y*}XILpD{5&g F?K-IӘdJ*mQ4Y2V1%u#D̮{:9ۼ2 CSv x ha$seEea :>4p־`w&m Rx@K<:d>-<;0-&c0Ԏr[x8fm(jA=@>]5Tf_3MŔAB!J7?DnU8P RJ?!χ(YO$"hg g~~ͨe 7(nǜ3 3Fí{NhdQx1o Q?G'z*#qJo+"X .U t 'Hs:cɓe$ػL46. V4 _9c]dHa uX:9`$?|-*+b1G$Z;csLީb?1~<$O nB;&O9c&qt+sbd''O4ҭNr/rnکMxD+VY\ZPkNL_Wv ]:Vݶ%2ɇ,,Fn-7|sr '8~}ѧo 0K alϻ3AeqMnWfYأt_=-3:72s]jh?GbN&oZwd8;1Z.zHq_, iL RZnv'80ߑ.;~8.if@$Yʋ[d e+WGg(z^T1UtANͅ dA戇Jc/9A02*OH|?`p"ԵH^bV-x,_d;m3tLw,)M0 Ol5 v? 7f4~6QB_ _+}tJg(-eAݸ^:C` D"ϑt*+ <M,e=Ȗx`$T-juzjWɶrc(m`Ͼ._YW0bePhtݹLy.78/lŽ;a~0L># I9|\cE6Fܨf{ Z;(=㪒v&~xot>OaH1ʢ0r8d1rnhT<֏sG/B{iV94,<N1υ|piTjI'Whn@Av_qy4JENM (GV{S{$2K-#}B5ðbzt ͛,-4  ʃ+c϶/#[٭Cm{}PsaU彎Nl7ίをJuocZ/ˆը0Bۑ]1o9´s4N8Q+&jt>/fVؔX QYEi] )\yk9q"ņV$ҟ~y1Qvb-P}r&j4E20mdТW-Ygh~e)Vdžb:ӮiF5vӛYXH_X۩']݂B1Ik|U K٘H&Pv@Av4y_R/k;c+6K릂k&p뽫Au6GzGwlG(Iyц^b;ZqK(]ӟ7Lf3[%itHpALzjF_xpKHtw(*GOZEB9մw]%"]o!ȏIi7ʤ>, T['b]7vbSE![TO.O< v+P1෴ ]Ё^ {۹:|a* 8Gb Yc8v/y=Z, VaB.d=/0>6DK}}>T>'2sg҈xZDBPn1v"be $1NC~-0z&X%H 600kFW_Z^Ҙ$g}JפY ?2k(g,~35K7n'g>PfGi xdL[,>?gI2>S#j%!K'H>5)%nUkta8Vތa0]d|Kpه8MK\oHZ:/iqE#'w.8llD3}7ouFAHlJ"OClb}rJJ%7>Oj p9[V%|r(8v]ƻN1_oxj=l0ҽc6,'j [šjLd7s7eMD#2|{M!e.[ 1ȶYb2S1m)&+T=/(sA$l{)G6#HDlbF+OK /+4MeS_vvhߒ0W[w%kp$VQǨ_r"^n޺NT$X+Ȩ=\> l@8Lf{,VC4C3Fya`D>!3I%2X *&M{e oέ.3AN5` qA n&tdq>C<\xq(R11V N'rGrLۑ3*p|ZV}4NC F]18A,\[ Gơӧ\+0q p`淜׷ ս1l" UȀ*7x.<~tO'\haopIDZȍʉq6;ekovXIl-R߅*#;wEJ (dS1 }jmGue HYb4*aWc)&.UJ1U#wLΕ{`bp ٩Rt޾oJXMJ sw9Pnƌu>XgRܟw 踝óSp"~3e=-W{ZzO?9FE-4mMCZRg4ړ'0ʱP(h%:gۻHINqN\iJQ"e{ ֧5di(Z&3gXl$EalwwQ4n ZbzzM<=&n=?0S:3YW7f>/@U޿ ːm:C{I^/ CV]a+XM'$+sBl..Db^E݈sk;H P  c&P/Ő'Q~JU,_MBC+\j~^%RZzt8J|878jnΌz>SPhR%S減!~n  2Cb8v4Z4`6itLW֒Y ELX`U:rϜlC8ԗU|rkrԍa[A B5=y 3:6Cd&0b.菱Q8~VI{ Dzu"A<]XUxxZsov\z_ ԕ}/ZED!yxVcL<hdSt?Aߞ0^m#nqpC6xjs׾:Eha;%gOtF݄k3˯<'M9&Xv(ع8M( }\m~cuu'Q43kzz" vNB=<8i柁E+,HץZHCvS<xO3G隞>)P%+/×W 7]^ =Χ[EfÉN +9{%Ve4BKj`kE?ؒL^&%>TW=z*KJ$y@ YAơd 8H!!Gni8ZEC &2v@琁oGL&Sd$`z V ú~|NpbgPq ri n|d6Fe~t6|gӂ58͡Mԏ/Y{rv6liN\cj Y#._Q詳GxlaaA(MsKC‹Z*.h퇉^[ $ߠO,=OH~WŸԴrGF$D&yƂYw鉄A2W_͈l< f%T.los聞u_Zfe6ۭ orR.n<0QWU~Cb*b;~ ,6ꢥ̴Di>|%XJD+Y 8|˄׹j VB?فx{0]B^Ν}OlxA$HvBF趹2,aS5 o&Gq…E\Qq]aD,4 ]5kZ庞v9ِ!𾋄 ߉E'j?t;b`8}ma;2[a^u f0kBľ56kcg> 1Nq/@락R v{D\z$1 PeA+hIH<_憟$]큚Sw> ڤjlJV=2&1Rh67W&8\!%*O ~9Q&mrg ^ȶW9PB}h6lm1  "\p7|d')+%ԧYYs:"-_$҇_ΝqʤM)3rq9C'>QZor=lԙ |`\(V>X|_`z *mF *9_ƌ9&r7;y(A@ QnBA[VnaVȵ_爩s$6Mxkoz_'?+/A6]?([؅A Z\1&: xd6C<'<%oޏO>Cl3R _N݀I^ DxH>Ë <>ӚyM[oWJ3탸hyB包/}ѕOQʴ{J0)H`bxYi}tHѶ){~~mI$j[o7vJ7L( ]q>k᫜iIP?U54W;6Pyy:Hnktk}|il|0C4>fIRVcb[BҘLv51#D{ |V6o`-oHb۬n3x W(׋rK!6ObIqfۃr/: uྣhsW">5:AN=D7kkF[[߁6dc9E e[m }' Fw3lO?wTG'[aݴHF>_涌H'ț~B!VT@88 d%kv9nǸ}Em)f[?yjk4|򑗎S aVfF?q=qu' _zhyzb ͫ 2qOBvDӅBG1Y۝Ӷ✍d<${R IG`x\ #*~SIE^RXA5{wo5 :q9FXi)U+'\6hY C׳~֞/+`ƣau: gH/=,K Wr|Wu4;3Y{%g]Px뎱nj/֢\眓 )c KTa.)_鰣g"qJ>Dz<Ъ<-,ҡ]J5c5A;J{lN'QIݹ(G};oK=mxnUZ~ΰvu#"t@nY}GU OK)< Y$Δ!MJ9&=DQOQ^Ǜrp:\}[kㅴ{:`{}KKq#(z~}}b$QFJ.R/- @H!&(WGk aKO#?3IDpNk8QٝĮ&DaP`\$nln ͺ|{my-v;s-*.NFY4@<~CG. Z4ÃK3ETWf:@&Q?RIe]Rm!1 N}U]0f٦`QHj_a0LǪ-ح2IMS$fp1[M9cM\WkoK.F^ǚA8t8CJs]R$`bUi=k/ȭt Y?OjC o+,yIj]2o٢Q .ݜkuqy!Ln":cxJa.Fj um:*օȥZ[Lq4v9h E=3Z}_)B}Х2SRRȆk;VC;)@T,J]o7 64mX Q[ʢìyզD?ѿ SF8+H[|1s u|9^鶍3`hӁ:MI/ABOgdlun7w-O)'ÐwMGx  ,5Iub) xiF5w0[˘ L(9ea-KR.n1bM0)2$X+  ?,ү:Qs ʯ!B6 g3Le)a!f!1LvF% m:RL|CJG>Ğ :ZWtn/+j7oW?w rpt'lٌkn+= gYx?Ҡ]zLH4q~4PFL4C2ˌmAZ %zBM)vRpN/I7:8>zPpkvc5A9S~V(\eǺ9=il ~WATzUU,@!3X ؋PH<%EۆDQd)kW{pfK~Qâ>,XNkLDup fחG"hNȌWG5B xQ\PDUɞONy} $-Su\@~i93݄әCr:a@~( VKۗLRYnE-3ZcА$sE)^x=EK%h$TtI_?R[fKgV@}ΎiD./Q+P %NƟYuԭ+pav^CWs$z$ɄLK,+o q5..o]d6Sij-Qnfֺ*%6'9A@@*}:9kMNï yG1stDZc]B<-Io a&G @#.%*)%p!r~ԓ*Mt5-G.ux >AƜpRͩtceR""8[X"9taI)OiC`*=@{TE֕YqϴI6|xѿvKxsi]CM2;@+nNzO>Gy[SNpc.:HGTV]3&:(!'hu5! M׫Ip}" (t*40L,7st-6+@.ƮA d@oK^#"ͣ#P9BCx1XCς S~ѩMXXp(p#> stream xڍT6Lww C7CwJw0 0 1tH#(%"4HtKwI t{yoZ׮{}_^ʨgȫ`a^>~I?__pKjaP2%PhxbA~~=%J =@ApX~PG'>Z8 1?7' A'Î`+B~C p}}}@n^|pOGYN/0xA<} %t@nKa9AR OA C`^.0{'aw@X/ ;޿AaA`0PW@WE\ d`'u@EAzPwwaڬ WA`/)A=!>\/;.h zxCԕyGAD) {#?woC ApwC '  ~   b?|ap_>_)߱t̅8CtK~~C\X;=_= sS B]m=4(+ /} ׃"N/ys zp/tCvyEGyW6AQpH 0 CA'U 1$~g| N" Pt|=|E@?C5p+aC\ASgaph@mTP(tSgK?\QX(/~^c{ɮ`}j`F$Bm O8ծwv [!#Ag)NJ_fnJ5V;`CMǤChUxZJajMH~t/eF׾/%< ڝ|w͓;thڎX7_rDqy 1Keom&86*d:\VxԎWRѧ4!RURlܞyl|5&Ҳ2 x2I &C<<[m2o&Tee$uMnO(:?*!O>$w}=C61=8]@x>ZL TëWET[Aujq,Xug^Pۦ hi*WYpKr<,5'&_պqr07YOEZ%tTZ&$Z❏\44jDRW݂|#i*m"L>;ϥ4!Sx ?7r4hI\/3,uj~g/qI `P[pnϘp>JC[U`;K'EP13pۍ N?ɅR\?Za3T^ZAD2AֶţWAhpzSO*1Cс(N)Xyʗ`8V/Jָ=}I%eFka*te񝉛Cd /|?v^I)ӱy:m /~1*V,.֔XyB* /]'֎'큡(V{?H[^DzL9xSMc;~lAZ_Z 2mC7!@0 =-j{f楪TE74,}_h"&FRĜLi46CRDw̚d`p+ :zZ\i tyZ>`F΂R:%\o?/7Y/3/=*|,<2d+H& Y{YYKI[~~9" ]|e?Y '_4sޓfڡ7^ \eo h8_ÿQ-w&yhոa"9ݑSld[c{TOVƴ&?DՌg28G-ѿbN=E>J7VI/SV+"rvŚߵF?=`B'RX_һ_o 7Lq:اlGzW. gĤ6ox}< }֒A6( /iSF#d{-6y?GG&&`gEȴDHvR^4ӀunY|8(f2yf֐>"+͆{:˲p!+{YF]fj4Ɍ}z2r%KSjg—OݳN I<$6v)2Uepd"RlcX;_}v;*Z9板+": ,/dOҖ9ma\S+xhECAX`-D\>2|_o0V^z}άk(CCỶcRrM TV&{Suĝ(IzQKz2j2pXkUtM2/m[@)pHYdƐRa*Z9vlZK:A\\4çPr\| znAൃvN) 71ku;~V|XH[[HE;$ڭIa}}?Tw4&V_o*zp^E^Ue+V6{Ax:6zގ3=~+k.uDE;Ͷ΄i3:iz qYH 9lrSsm.\,v[?_~݊&IUF1yqFOtRqqȓ&) `mt] [ʠ!hrsV&,`YY{Pn_Rchqt9gi&g7"l~R4XܵkKꍵ wXw~8k;7ʌޯhGvL6bD,ٛIa5% ?e.wgs~чhrgf z:8'Fuڢ1~iqQ [Xe\ꢂ1_qR ]9k Wϸk#2cpo#vkCXuCW G;"U/z琌R=\G !U ,K+c$4< bEպDCHE6""f=+2&U]gY؁.QnpPY(*8`#U ]|,c8OGN.>=5{ye)Kne,E| se kdQ,?:&ӏW&WPc077We/ҥ"<' IvJðѩGi$=])*DhipӞn/-oC9X\qn!2*⏸Cv;xUkՈu*9[nvMVS/zTV\"ɖYưbSBlH"בgE^rK(O`7~X{$fbhR&ZP~FPKϺmb F&qXins8zyt/ؗs3fZ2Fv sdT63p ׮0[!Zb GH9VIɳmj?CX6 # ;̔?ftrMe%ҋ_&TިA/kZ V%m1b(tzh U~䁝&Qnm}%?5V0#3n-?D78`l{\֗v7f`Ԛ t?y|ކ[0TYǾ$WQ6Zʰ,n"I{8߰w Xۢ'[U. uL~k[eq=b2$N..=q]f{EFCk1cI5̪O[]J͇tUʘ5ɳ:TK$MGQc\=2Y?E_XGen?^ޱ5 <#*QģJA-zt;9?<]gO)^0%?ϗ'2^,n/4}VKC2:P7) jl4Z̘Oh-QIס*"mĮKm>}  DdG 1AK#);̃~7=Asϧd«˒u#x+'_u5j<ӧPc%]墩2y?oa7]oGZ4w6k[1-@u~D! R]ߛ-a(GS* xP/e5%ynb?>iƴT|\~[.PpE'5iJ[rSU﫾~I?&]fv9Nx91V"Ϟx2ŭ+y([ 0qXL7;Vp,*ЋSUh~wt̩5kip Nе.|i$\><{V(SPBYxf{Cq~Yɮn8C)͂3^^oׁmQfʫ B-O"DW[ 6D C6y1 ..ffT<*9PtSˠRj.˥rK'FV REFe=.X@mjG EG\peʰ2qQFU2ViA" iDM\tFT3ͦ#J †r#<=;K}UfʝC/l ݛ-z/Y-/fh%CD('`k Kg_ȝuNm?Gs{K{%ڵɝr6]%gms9rrY+;wcgjvOJ`޸4_]d&(_ye~E>jLSNAG͋R[1"g9[pBc E_u^oy@rʖײv]YEQuaVw$w:MndFqnSƣQ{4]vC'2xCFDө9}(e+snӡ־1@^#Q:Ea| <_~3'cP4=N07mP /(+KT3+C&%:,R:ΨHRG14nM49O6Z;]([ fN/5Y/y++uByNx ה@HՖI >DW50@p.0eUt^s vN^Th\'9zJat0ώt6Qlxyeޙ˙QAd珒㪽# z\C2dcq#>A+6zk &osmӞ(wU X5L Vѐ5.d)7m낔RFܶIѥѩNEoBSe^2W Ҵ|\lr]6 jk'4 Wv 5*ѪW4xVм04:󚩓ĺ>G̽̐`:85!ݓV:~az"&@E脟n[=$w#R\7'GZ驁*RuDeJBmb+*ngNsbiQ(DQl1db9J)d[[BR{4ŢX|9@9х9N:az 0}!v%ÎK ն➷B*o.5~83-*!d kuYovFzϧsH͡TCyY4uL6,t?{~I xL ^~ab8<n*|O߾1vgˇ>? `='У!&8YM~Q| @ܣHT5Y@H|{6(&OOvdi j k麰OՕg O= ћZ,St4:4֎Cr y dW {'+,z>gs>V{]Ďe>UUW$"RS>-[dK٫K&n_6$ wlxVr7|LHvX=(F>ccN6AVK/;><<ؕO?wB#}sj:A8gxbE9P3OĭlE^s@D V9ϯ1|F=ZƵyO}ɼL5tG=Cցb)wW$xeW%O !?@|F"Z,' .;}D~ANLf{:~܋B實ƝM^gOfe:Tr\.ȾzY 6W y`R^m ېCHr?.Mk^WXI?ͿtWzeV5:awz95s )*h{Z3" Tnb@mk[ߠ$֏m|?ٯzaM-Qn2ѠٺvdtD{toXW >!i悐pSTc[xf1PR|LRzbeht~Ǥ+XSڦvuL9ԇId{Qw6IB.P4x&ҏL9;Cύ"pm@K*"&CH)B%5yOx|Cx#/ a)4@--|JcW4wzDȧbk#%]Pmʙϲ:+ xjS}Lu%EFoq*u@O5݃Cf9p2e,,i{c}פdV\?lV߸Z)ߵ.dIJmbi4s[`]sѦl ǼΑLhVlj˹r-6TINvﮱS;wssHgxBZL+~_s]VEqMk+wZ\JVw"uj D}UMyz$2G6˯_ DX!d:xW#@B/37#&-؁akc9Ⱥ?z $+(RjB># dz. RNla=mMUV(ɣXpRADq0y1KՍ@^X8xG<ݺn5B=\Q6Wly]tl×ա61%b, 7;{4%]g_/( fDŤ#wwqG"t$;M+#g endstream endobj 42 0 obj << /Length1 1713 /Length2 10295 /Length3 0 /Length 11403 /Filter /FlateDecode >> stream xڍP-[p'NHpd  !8!HxdwUT1ӧW0hhqHZBArGWNnQ67Aj !O PPrxEyD"1@E2@w%@q`0HC`kק< ``tA@G*hЂXA^YIà Zbax]m d 2@ 5N  O{^@ 7ԃ/ zj =}a\ + % %`;b Y)? q?я/'YB1c\ jҒRRlRJ q8x|BAAG_Vȟ>M?΃߱ Onn?2zAk_nPӣI=-?/$ 2xd[Z܃c{ ö^2  5*=p z)0܃%|!D vR4Fsj cqx`"PC[b痳nb |C0F.Gg]ѐ;UK9"u"2g̑ҢrPz^\gMw(pCȏqbok9:b/Yyx7 _A,UݣPռ`;_. /k'G616Vd~:PɷM+N9xxj~w@OH%Omb!^%fhlIN+qΨa򝷇E}D9~E̱!Q9vJ8{PVpr5WJ6#1ݫnҜ;K<:k×M{Ñf 3Bo(. ksBe >3fG*>ߛĊCjdgfT@,u?eY/:l|&&94%Vg/MI> ¨rO9=_9)̨O$_K拖SS$) \VS|q%:Ba _·6:pǶ@BvS`h)O9Zl! )snFGX\'G"m~7o<~Dǰ(0 hc >+aX3u2PraErSF Ӑz;kS<-]`ǧlmIěCx,dSa&Þ,O\EĻNN7J`Mʙh'rd$d:E X{\vsfg5uJm >gyĹr#gSPՁ@ۗs({<ף{|Yơ^͵GaY,|>8++>btʹQS13Jj?c{=hhҘe>OoNwR]UKCf"[c Lu'}7,Byv)!"^6%7pw=B`%=_Arv-[wa{e$/6͂:ԌD#KyuVAyfZt4I/lR˃,EzL;숡pRdQ휐9b?N]b.#2Y4/%f'L̨*fPRn))3(o`1K]PcU݃kjbKZ83!֏dwV&ʀ<>XZ1ERiȬfH 7SB%is$O.}#p2]âz4o9mqf{%HL=f6&(=Qe Asb?^f\o$_.ְ_"\*/:RE`0c<1*rJǔEr;=97eg=M¶އ,ܴ`2l̞p P@WSs2?GFuvjWGm}?kɅ 9ckOh:]n^ W;bNtQݢ4af6|%?OLJ/6^*b[tR׿_ENcAǏ>$Ť!U4@[rH5fr6Pir{d9Y$]ؒ!_*+y<VY磉 TVztY7FhC}_5>BamPnGҬY ~Wf21 }l(`t+r.3N!)O+ys{Nw).t);;=;O'riRl! k,{NwWGB:GozQCp&Sy"Rw VP<.c$<. }ayX[* Ć[>PxK3h2^Y<ţw_ю%?t|O'y]h-UoD%RD܁R8-qϳ%qa8:[8{Q*/*/nsF.CEİEL,SƩ48Yi# ̘T~1#>@:Q%(ӐצE]%=1jv>3.U?D<af%ZL!ik8umR γF/HO{'c E_얨lhރS#.6h"vl&p|Et}ո?w#-RK^ѤI6bhDFNPa;,>X10DMyʯl gu궝I+זvQ@&]JTt>^''^G-U:3=&\ ŒNIX@~H?ͼhu76IGELꙘ_IRA3CK |ST9ev+n;0ח>a2~[⦪T]qE,m ma #IJ"iRZ?Z麪(bzN #k94o(0G[Ω.&R ~A~*+{O .h3Q6E.e^C*?iq=}\j` Z46`tڔJ*#=)dB%cy-#d\W}LSۼo/ϔ/\7;Y6J=9>m%q~d66V $D)^7c'Q!M N踐zoHއ`9YrI ;+( U¦H7q7Tg٫J+*iHΆ0|!ne"4Rϔ_ 挛kOK$Ҿ&pM#繪{tQ<\oR#6|m|׳ 0i4p9)e}6- ,XmUJmXjn͚+ų-Zmx`FWZ;2B:' _ETe0+MQjT ;ؕ6v\~4YzX@hԥ6 1*!llZqd$'xx+`>BܜٍeGiRw{aAkOJѥ~0C줃ԯ/d+T|*zkBtCEן)닶wpJw/joRCWAZ7;ݝ4|hRָH(K(59 +Y¶هSBS6x^ylZɖŻ옲bo ןK4-YwՎI lCK@+W[pr߾@G8vN鍣[hIܙ*F u  dM" $Y%;[v?ٴ|G7ڛw|3UY)-r^/4'f^1,;WWVւGjWnM]fqg.1Wux}= Nj|9dц䶾+D{-z|LQi1+(EߵͤpXRnx a,+sks\ 4eeJ) >tPWcC{mY*,_&ŸckǷtP.^LoX|:M`EmW[{%A pr}i^ؙd+AEָ ڥ)ږ_+vʢ@wHNu9^^TS)k_t/k(k Ŕ5^.]Z7I6(Sq@^l0f?3̿+H|g"@L%8+")C@7:Y^oOI +Rd* v^v78bQVq|930D+RO962y;O*ʛ"KqͿq)ŕaiD&W_~+NfpjIƁk W.´!qQ$2G?XFTw8tܖ A>9ORTgشu. fj\N邇:]uϊw*m+\-Z[FzuRYZrD_'PԳ QC?J!҉AjEOy!}TӑY;Q9~i-` }#&xT䁯ӱm8k :ciV0F ں3i "ָ,ϟkSv]ב W˧6*,^Ra +J0}4A9irY)K8%WP^dJAIkS)ѳcwkzZ) Bl#MA,H?L%=56jG^bDiY"ٽ`A>pqWU5M8*:#^ɭ0,/?Rsy˵m~WR=P 4.xm<7:7E T/jS-kslc 1M99}! Idoa5}oTѽ,n)zcN`Hwf)֧}Ŷ[{;*X7r8([%va&K-JR?Z^Zzbq|}c.Y_ܩb)Q7P\ast´deh@~-kiB+oP7e?K}qWH oqM=<.rD~?Fe_kEamT4{IVd}ɛD{Ci3ُ qrz3u[]} |޶2 ̚Οr, 3=Y&"PNSNM WKRj2!#yϩS{b ^2MfҾ `fߵ.#c ڋH@,2W2SCvi >*<>~C_eީkKxa챟1x204*g5Wd=~er!mĦҼ6E3~QE\Sɬ ø9Ӱ8LіǨ: B~Pf43`Eq#pnq^';b=E!`6 A|>(YKtt9E/IALp³|0X_o1ljr\)~NSmĎR0nN\ax3!(lVfr{׌Ede/ptZ-o.G[3ZP-9TH 3 eD9ԛ&*}y#R\^p"Q#ź*0*]?N/IbVOezy:+9p.X:S2 vC/V;#7;hV^[{pݻYI-2;^&lwdd=4 s֢s{ 4|ϭc‹b-5w #s'8&݌jֿS|NL~lbFl:wNĝp*`bK!xqo5uxxGs۹J][^Tϭ<]w5fa`,驾cm(. )08avO2guOجq; )`$$k*mBM>6Ʋt΢7#U3 JW68p󪵻i6N݉ ObWPnVh2r#kOem6%]lUDc2VK `?-bCfpfk0YSiQ5d%H.:u 9& }n)4 [}\vj,y@qy.V c0e\9l0w)]cf*i.DA|Uz|]cϰa(h'VfkvY^*}ħut k3kކˆ:*5NWg_1 1`1H/dڑZ=Zd EA{[VePR^ w׺YQm 7Tg.Hu{zc8]5 q%#\NR!EûÖzݨ>hK޺l՛\ endstream endobj 47 0 obj << /Producer (pdfTeX-1.40.20) /Author()/Title()/Subject()/Creator(LaTeX with hyperref)/Keywords() /CreationDate (D:20211026173509-04'00') /ModDate (D:20211026173509-04'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.20 (TeX Live 2019/Debian) kpathsea version 6.3.1) >> endobj 2 0 obj << /Type /ObjStm /N 36 /First 266 /Length 1904 /Filter /FlateDecode >> stream xYr7}W-;PJ6hj,qCq/fH8O9GeL1%eB 昰:cIN`:À`:&%3 gY&A+``7lZoLIc J2/ U 6(Ô9 v\JmOkQL- f6!hW`Fc{1@hf<6(,31YϴfVV›v_0,?d9gxR__~猿~P|VW̐ހU(yY~3ٻ uA^:5W~9?vfetzA-Dlqbi/w :{!FI!P\an@'d+TH},yށc/5[~sIϱ.h_K{6?bArK>g95i5D29뇁1;t$[$f+;(VR NwĊ)FhmeFh$Cy^NH_5 2y rZ;*e kX5Y}lqyYA@ݻ8::P*EP(C:<ը.l=O^ t)R o/t.è7v KRu !0MLh`R v04AA1-f)Q )['n|TÌU)7.*ۢӔGk3D׏H9]ty锔i{oW9mU~`o0nDѨ Iq1Ģ~'ڔn4XW~4 ;]cQWE~4:UMpQTNn껊^nV}b7Gn 6}t+Opdv<|}?=^Af^o_֝-l_zבw]=tN/+zC+O}._Rܳb{QzCg02;vrU>'"ꍩGIO'綫zٜWӏ$nΊWz^^^Dk]VA endstream endobj 48 0 obj << /Type /XRef /Index [0 49] /Size 49 /W [1 3 1] /Root 46 0 R /Info 47 0 R /ID [<4D5A8733D395C8465ABAD12D8E6DE568> <4D5A8733D395C8465ABAD12D8E6DE568>] /Length 148 /Filter /FlateDecode >> stream xϹmBE>g,6bD8$s@dh^p'9H#IDJdEF BR+ǩ 5C2hB˪bm-/QkwO|ZET]Eas7 endstream endobj startxref 88673 %%EOF graph/inst/doc/graph.Rnw0000644000175000017500000003444614136046755015046 0ustar nileshnilesh% % NOTE -- ONLY EDIT graph.Rnw!!! % graph.tex file will get overwritten. % %\VignetteIndexEntry{Graph} %\VignetteDepends{graph} %\VignetteKeywords{Graph} %\VignettePackage{graph} \documentclass{article} \usepackage{hyperref} \textwidth=6.2in \textheight=8.5in %\parskip=.3cm \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Rmethod}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \newcommand{\Rclass}[1]{{\textit{#1}}} \newcommand{\classdef}[1]{% {\em #1} } \begin{document} \title{How To use the graph package} \maketitle \section{Introduction} The \Rpackage{graph} package provides an implementation of graphs (the kind with nodes and edges) in R. Software infrastructure is provided by three different, but related packages, \begin{description} \item[graph] Provides the basic class definitions and functionality. \item[RBGL] Provides an interface to graph algorithms (such as shortest path, connectivity etc). \item[Rgraphviz] Provides rendering functionality. Different layout algorithms are provided and node plotting, line type, color etc parameters can be controlled by the user. \end{description} A short description of the R classes and methods is given at the end of this document. But here, we begin by creating some graphs and performing different operations on those graphs. The reader will benefit greatly from also have the \Rpackage{Rgraphviz} package available and from using it to render the different graphs as they proceed through these notes. \section{Getting Started} We will first create a graph and then spend some time examining some of the different functions that can be applied to the graph. We will create a random graph as the basis for our explorations (but will delay explaining the creation of this graph until Section~\ref{sec:rg}). First we attach the \Rpackage{graph} package and create a random graph (this is based on the Erdos-Renyi model for random graphs). <>= library(graph) set.seed(123) g1 = randomEGraph(LETTERS[1:15], edges=100) g1 @ We can next list the nodes in our graph, or ask for the degree (since this is an undirected graph we do not distinguish between in-degree and out-degree). For any node in \Robject{g1} we can find out which nodes are adjacent to it using the \Rfunction{adj} function. Or we can find out which nodes are accessible from it using the \Rfunction{acc} function. Both functions are \textit{vectorized}, that is, the user can supply a vector of node names, and each returns a named list. The names of the list elements correspond to the names of the nodes that were supplied. For \Rfunction{acc} the elements of the list are named vectors, the names correspond to the nodes that can be reached and the values correspond to their distance from the starting node. <>= nodes(g1) degree(g1) adj(g1, "A") acc(g1, c("E", "G")) @ One can obtain subgraphs of a given graph by specifying the set of nodes that they are interested in. A subgraph is actually a copy of the relevant part of the original graph. A subgraph is the set of specified nodes plus any edges between them. We can also compute the boundary of a subgraph. The boundary is the set of all nodes in the original graph that have an edge to the specified subgraph. The \Rfunction{boundary} returns a named list with one component for each node in the subgraph. The elements of this list are vectors which contain all nodes in the original graph that have an edge to that element of the subgraph. We also demonstrate two edge related functions in the code chunk below. One retrieves all edges from a graph and is called \Rfunction{edges} while the other retrieves the edge weights and is called \Rfunction{edgeWeights}. <>= sg1 = subGraph(c("A", "E", "F","L"), g1) boundary(sg1, g1) edges(sg1) edgeWeights(sg1) @ \subsection{Some Algebraic Manipulations} The examples here originally came from Chris Volinsky at AT\&T, but have been modified in places as the \Rpackage{graph} package has evolved. In the code chunk below we demonstrate how to create a graph \textit{from scratch}. In this code chunk two graphs are created, \Robject{gR} and \Robject{gR2}, the first is undirected while the second is a directed graph. <>= V <- LETTERS[1:4] edL1 <- vector("list", length=4) names(edL1) <- V for(i in 1:4) edL1[[i]] <- list(edges=c(2,1,4,3)[i], weights=sqrt(i)) gR <- graphNEL(nodes=V, edgeL=edL1) edL2 <- vector("list", length=4) names(edL2) <- V for(i in 1:4) edL2[[i]] <- list(edges=c(2,1,2,1)[i], weights=sqrt(i)) gR2 <- graphNEL(nodes=V, edgeL=edL2, edgemode="directed") @ New graphs can be constructed from these graphs in many different ways but in all cases the existing graph itself is not altered, but rather a copy is made and the changes are carried out on that copy. Nodes and or edges can be added to the graphs using the functions \Rfunction{addNode}, \Rfunction{addEdge}, \Rfunction{removeNode} and \Rfunction{removeEdge}. All functions will take a vector of nodes or edges and add or remove all of them at one time. One other function in this family is \Rfunction{combineNodes}, this function takes a vector of nodes and a graph and combines those nodes into a single new node (the name of which must be supplied). The function \Rfunction{clearNode} removes all edges to the specified nodes. <>= gX = addNode(c("E", "F"), gR) gX gX2 = addEdge(c("E", "F", "F"), c("A", "D", "E"), gX, c(1,2,3)) gX2 gR3 = combineNodes(c("A","B"), gR, "W") gR3 clearNode("A", gX) @ When working with directed graphs it is sometimes of interest to find the \textit{underlying} graph. This is the graph with all edge orientation removed. The function \Rfunction{ugraph} provides this functionality. <>= ##find the underlying graph ugraph(gR2) @ Other operations that can be carried out on graphs, that are of some interest, are unions, intersections and complements. We have take a rather specialized definition of these operations and it is not one that is widely used, but it is very useful for the bioinformatics and computational biology projects that we are working on. For two or more graphs all with \textbf{the same nodes} we define: \begin{description} \item[union] to be the graph with the same set of nodes as the inputs and edges between any two nodes that were connected in any one graph. \item[intersection] to be the graph with the same set of nodes as the inputs and with edges between two nodes if there was an edge in all graphs. \item[complement] to be the graph with the same set of nodes as its input and edges in the complement if there were none in the original graph. \end{description} In the code chunk below we generate a random graph and then demonstrate the concepts of union, intersection and complement. <>= set.seed(123) gR3 <- randomGraph(LETTERS[1:4], M<-1:2, p=.5) x1 <- intersection(gR,gR3) x1 x2 <- union(gR,gR3) x2 x3 <- complement(gR) x3 @ Notice that while the graphs \Robject{gR} and \Robject{gR2} have different sets of edge weights these are lost when the \Rmethod{union}, \Rmethod{intersection} and \Rmethod{complement} are taken. It is not clear how they should be treated and in the current implementation they are ignored and replaced by weight 1 in the output. \section{Random Graphs} \label{sec:rg} Three basic strategies for finding random graphs have been implemented: \begin{description} \item[randomEGraph] A random edge graph. In this graph edges are randomly generated according to a specified probability, or the number of edges can be specified and they are randomly assigned. \item[randomGraph] For this graph the number of nodes is specified as well as some latent factor. The user provides both the node labels and a factor with some fixed number of levels. Each node is randomly assigned levels of the factor and then edges are created between nodes that share the same levels of the factor. \item[randomNodeGraph] A random graph with a pre-specified node distribution is generated. \end{description} The function \Rfunction{randomEGraph} will generate graphs using the random edge model. In the code chunk below we generate a graph, \Robject{g1} on 12 nodes (with labels from the first 12 letters of the alphabet) and specify that the probability of each edge existing is $0.1$. The graph \Robject{g2} is on the same set of nodes but we specify that it will contain 20 edges. <>= set.seed(333) V = letters[1:12] g1 = randomEGraph(V, .1) g1 g2 = randomEGraph(V, edges=20) g2 @ The function \Rfunction{randomGraph} generates graphs according to the latent variable model. In the code chunk bel <>= set.seed(23) V <- LETTERS[1:20] M <- 1:4 g1 <- randomGraph(V, M, .2) @ Our last example involves the generating random graphs with a prespecified node degree distribution. In the example below we require a node degree distribution of 1, 1, 2 and 4. We note that self-loops are allowed (and if someone wants to provide the code to eliminate them, we would be glad to have it). <>= set.seed(123) c1 <- c(1,1,2,4) names(c1) <- letters[1:4] g1 <- randomNodeGraph(c1) @ \section{Some Graph Algorithms} In addition to the simple algebraic operations that we have demonstrated in the preceeding sections of this document we also have available implementations of some more sophisticated graph algorithms. If possible though, one should use the algorithms provided in the \Rpackage{RBGL}. The function \Rfunction{connComp} returns a list of the connected components of the given graph. For a \textit{directed graph} or \textit{digraph} the underlying graph is the graph that results from removing all direction from the edges. This can be achieved using the function \Rfunction{ugraph}. A weakly connected component of a digraph is one that is a connected component of the underlying graph and this is the default behavior of \Rfunction{connComp}. <>= g1 g1cc <- connComp(g1) g1cc g1.sub <- subGraph(g1cc[[1]], g1) g1.sub @ Another useful set of graph algorithms are the so-called searching algorithm. For the \Rpackage{graph} package we have implemented the depth first searching algorithm as described in Algorithm 4.2.1 of \cite{GrossYellen}. More efficient and comprehensive algorithms are available through the \Rpackage{RBGL} package. The returned value is a named vector. The names correspond to the nodes of the graph and the values correspond to the distance (often the number of steps) or sum of the edgeweights along the path to that node. <>= DFS(gX2, "E") @ \section{Special Types of Graphs} We have found it useful to define a few special types or classes of graphs for some bioinformatic problems but they likely have broader applicability. All of the functions described above should have methods for these special types of graphs (although we may not yet have implemented all of them, please let the maintainer know if you detect any omissions). First is the \Robject{clusterGraph}. A cluster graph is a graph where the nodes are separated into groups or clusters. Within a cluster all nodes are connected (a complete graph) but between clusters there are no edges. Such graphs are useful representations of the output of clustering algorithms. <>= cG1 <- new("clusterGraph", clusters=list(a=c(1,2,3), b=c(4,5,6))) cG1 acc(cG1, c("1", "2")) @ The other special type of graph that we have implemented is based on distances. This graph is completely connected but the edge weights come from inter-node distances (perhaps computed from an expression experiment). <>= set.seed(123) x <- rnorm(26) names(x) <- letters library(stats) d1 <- dist(x) g1 <- new("distGraph", Dist=d1) g1 @ \section{Coercion} There are very many different ways to represent graphs. The one chosen for our basic implementation is a node and edge-list representation. However, many others use an adjacency matrix representation. We provide a number of different tools that should help users coerce graphs between the different representations. Coercion from an adjacency matrix to a \Rclass{graphNEL} object requires a numeric matrix with both row and column names. These are taken to define the nodes of the graph and the edge weights in the resultant graph are determined by the values in the array (weights zero are taken to indicate the absence of an edge). The function \Rfunction{ftM2adjM} converts a \textit{from-to} matrix into an adjacency matrix. Conversion to a \Rclass{graphNEL} graph can be carried out using the \Rfunction{as} method for that class. An \texttt{aM} is an affiliation matrix which is frequently used in social networks analysis. The rows of \texttt{aM} represent actors, and the columns represent events. A one, \texttt{1}, in the ith row and jth column represents the affiliation of the ith actor with the jth event. The function \Rfunction{aM2bpG} coerces a \texttt{aM} into an instance of the \Rclass{graphNEL} where the nodes are both the actors and the events (there is currently no bipartite graph representation, although one could be added). The two functions \Rfunction{sparseM2Graph} and \Rfunction{graph2SparseM} provide coercion between \Rclass{graphNEL} instances and sparse matrix representations. Currently we rely on the \Rpackage{SparseM} of Koncker and Ng for the sparse matrix implementation. @ \subsection{Classes} We briefly review some of the class structure here and refer the reader to the technical documentation for this package for more details. The basic class, \Rclass{graph}, is a virtual class and all other classes will extend this class. There are three main implementations available. Which is best will depend on the particular data set and what the user wants to do with it. The only slot defined in the virtual class is \Robject{edgemode} which can be either \textit{directed} or \textit{undirected} indicating whether the edges are directed or not. The class \Rclass{graphNEL} is a node and edge-list representation of a graph. That is the graph is comprised of two components a list of nodes and a list of the out edges for each node. The class \Rclass{graphAM} is an adjacency matrix implementation. It will be developed next and will use the \Rpackage{SparseM} package if it is available. The class \Rclass{clusterGraph} is a special form of graph for clustering. In this graph each cluster is a completely connected component (a clique) and there are no between cluster edges. \end{document} graph/inst/doc/GraphClass.pdf0000644000175000017500000041470314136072201015756 0ustar nileshnilesh%PDF-1.5 % 41 0 obj << /Length 3382 /Filter /FlateDecode >> stream xڕɒdn,N%UR,9J/áeB^@H:H_}ys7)lflUmVTmmqsuQ,WEe,X^l鲆wMUY!fUY7ψp,N 2@/md4Oÿc/6X|:!IwkE?aEmhR5b)aGbmfN]A#hn`DVAԭ\$c?Eʊe4c WLV3R3Jה9%/ɿ/aʥU_jgWjv1\0%#ʼg:OD$'H(I)իt9\ҶYl,!Me>E@V/n'KVUx73qLi`? z@!7K?-7FEG܈+IvIH=P3*tLXApg]7Y-z BN~9ꪙXZM04TQ^L|SHP;7JI3Onu<صTzbΉC1߬BPȿje/*>B{B9䟨r63J6fM빬mqBګ>Q8P@WRiҕ*l;UNǞD@ɞwNCDx"N+Zڴo4AikcRU)}mT:dN]A``^)f2g=BuT1,5vLµ=bg-4B]XgmPԸ=>g:ǰ+J5C8W~|3>ЖEиBˉX((I|r2b@9Ѧ6L5-S>O8,dŏQv+7/h?@c=ɩ}GݳȰ*|:4*"~ S!NSek7'.C:#Ahb$Xjs*-Kgp5gpۈlèEHVY|KaW5 );!uN=/Zg{P NOAvC0Y|;h[Β:q3D*ҏIKq5eNČ MBM~`SW x9wƍ0qqAl-J'))URUy8D(^4 󋑧Ix[.zz Ax< (|Gݽ[ֵz;p*O'7h{tPgOʝL;)8̉ehLN02ViT> Gá#0&qpLw'9fY较KYHP x(.JKjK_79b͖* Ypwx9RS*$^Wԋxt?1MMW5Đ |)>D#UKз* R@v> stream xڵZKW[%ʼnWRRem*8,]R& 93+)N3ӏ{W߼n.LqsxSgQe7EGeon&MxM%ErFmF'ு l,ʲ͑fH(szY8463Ѣ|ss{EVgJ(eY4T7`M}͡!1w΄ד\㹊̪'\#-rB zD_R+G Yz]>mA~ e#m^Uی",f}u2 I6{5U 㬌gg}ȶwy2o:Ҵf9:-*TV6C;(>WU:T躗-Rk,8Ux8Yo3M$2e4$LY%&ΆPE 9uVt^Fij_q!L1rUra+Uw0"^4 :|7GE;`iI'Ij<|7ӱ[>gdpSJ  _W+,ɚ˧K`g#8th'E2Tm<em/Q 7m]  ɍ,LcxVpC{A܍к0qOrd;xW@ .1v6r(+WqlD7C ӫ]|ڷ3U۰Z-BH `% [ EzW+`G&"JxG Fy6Gi6@"] Ѡ<"jXLÓuB?jr`w0卧V;R_-FIẋONYnhj$.4 G[ 4%,IjFI2V#!(6.)clОBCHf*?qh)B,U4mKbmZO,Q0agF&`C^ fD[W^·48ɐ( õN(ʰ$y^]U (.à܌.jv4Y!v,z|<.t&3tlms#g3>DR }3R\0V?Ψ:CRbN$[ͽ(wVC+sY`4#1c3Xx>5Bb|J4:䍻%;|eHe]Iy,(qYNbdżU+pQ=v^x|'p2D\Iesq O:1KdKy7( | @vIGe\;qn#‸u< 8&9٢j!xP{GZ B}J$GC_%m[ٓ;v*<8  ^ix]`&,]dj;53ƌ1*>d- 4 j<?kJV͒KE٠Q'ul_݊0mr/ +at pѢbں`Qυ.WQ(A i4ܽBB_Tzci~~|0; T\Wbê]gd6/9PU[6 TUvsfl]Xj<*ڛ)vGIsݼQ`+JŗM8qhtVw F%uH,ج&dPـ>'YYxwв<)&-AӼ?QTxJſ<恠ޤaK _ bqJWoT1Z)Ob٫\p>7:.J>][WuTν/$L#{+U;?KU&(\6 ]΂f[ kbؠ ,OR6 ԷLgή't5'/Qqk ³N[o<ܭ {AGQ=U m})3M~GwR[ʇLT_2W #$>&rD`Xo^.}fVyT_XCc=$ۢ>| |ؖMs~,Кw,K/)/o] Z+.k.9FEfc-rmœQq|#4Z#N:tK]m۾pKqOēFU#V@3 vRWwwL 3ߵ=R4/η$n~spy.y0 -e>|HLw`SU."qyb<.}MPB6Jn°0 endstream endobj 61 0 obj << /Length 3577 /Filter /FlateDecode >> stream xڽZKsWrU<4𹩤jcˮu7UYU|}84y(_~hT4$6ݍg_|ܕ1Y[n3{UyVvuffa&ކsn=ű[ ?~U`~4M7FaVZe{h+6rk+|nvsl?I`-(c 2cO'7?|"_<$B:6]hQ)kɶv͆ z>ƀ)Ed+Y9+!> Pc< Uj sOb/UO=&# 6>3{93C9bzqwbDŽvc;zr;y,3F$MڿȤ M0]|3"N`^ +Bd\G5e{[^oc1-4=YeM루$,L>yk r!e"ֆ$i3c&2NBΑ_Ft/L)x/DEu mn9?n%T4$Qm p׃L HlyHԾER'68D!ؾxi:^5"UVؖ* $}p?8"vĤe m6BX ĽZ6ZA߈Y:r/Gj|R 0!WTVB uC nT$kh dEh_ou$A|zF&4R1ai',*apPɺ6u,'fG݋o Yv$ynC#nPdlMqmyպ9^鷼Q*'(>]H6<}*eem@ \h[0IPZGz_ XI; 2fК x[b +h}yPz%FԚxR!d}]o5?RACQq')W֨_B46gj"U幯|stM̟Q /zք"?*_lɣ%&HΕڪƠX5_ԃjѴ4YYk0] FusTP5΋E$X3% .$!$J->J78$N TВŨC}.GM=LZZr|3Cc}:ql|K>=d>\ f>R?_ endstream endobj 67 0 obj << /Length 1706 /Filter /FlateDecode >> stream xڥXKs6WHT $ql:M&=tz$R*Q}AIVbK>wo޾7fTՋEr\N-7?2ߩL-UQ vnl޾o.wPDX&7(i|Ǜ;o v큲a TVn34NrvMf=qg*F^nI(csKث [fT#{Ԟ3ْ@f\"Vy:xX5KxvH;u m-pH`{1epwSF#AsS g]pa5RWau[chUM {LP {iC!T,@1|"/ FзXG'( k="]&?VNR.m U H,.Hjtu<>[mϡAxQ$S:S: IZ;pg)QGY𘔻k'Σ&&n- k%k&0p_(_\Jpի nE ;*{|vOKwx̞s WC[d?xhyp |4C* vI nY+^z7m"$`:ͯκoȶ7TQ^SFBŀn@M;1e{[p?ne 8ʈj4i)ZB E;>g/})mkW9&+fY8l~ݷ߃q;N~:ҏCȋ ˲ltgYѝGyeUx@ؑ rA:sDRG6"ae(ҧڋK!B>MB'$|]1qϦyN&y-S?PjZMV*TF4!Te,\Jj 0קdб\O^1x:v2 ƕYo'v½KEt`QLnFa6NTUxBgv4H}V<NoE<^ ; |LX~$s֐,Δ. !l>qʢ(8#ݕ agJa!Lq`Q$M5ӧ/Nk PO@Qix:6)NYL(zjA}gx|E.}NN23)׺jTmB}s\nڔԑŃf@еf:v.[W 0c_ Y5Xx%Cmm[STL n]O_ ?$d endstream endobj 80 0 obj << /Length1 2038 /Length2 13535 /Length3 0 /Length 14770 /Filter /FlateDecode >> stream xڍP[ nmp 0Cpw'Xp s{>yսVrbE:!S1PdLD fb02322ÑZ:##W::Ye 4r~9Ɂ.6&;77## AQ#WKS=@dt#{8Z[8/?*jB@GK#;}E# BPZ8;s30:у?,-@'+Wy#[?ÑT-,̜݌w x_"% Pc,gDp+F&& [{#;K;s  .K`dg̍BJS_%2}LE@@;g'to?'kmrYڙU= PJ?&"?2s3 tM, a[/{=pvtx[ `ji 0[.ha|=&_>齷)ˠ"/ IO ^t:f6F>;O?3ԀK޵@՟&edc4yc5MHo5 ޛ}@c`M5 0ꤜ@濛h$n4Ut6W5c6v@E_ pzoȿUKٙL0f6v}M0x/`r< !0!. X R=z)c8 =b0!6z_z'?zNcמ3  4/E S6Ƿ{w} ߓ3PSػw̿Qڿv6@3?RH߳Lп6齴^ӿ38[8d޾ n9˿p{1no_ow`MM~ρLxjvfw4R~;<"A'RWf9 %u,oQ.x5A+>y?*O-LbO ө z8xY7uH8p")߻J.(V?NEE͒g&r#A;wGA˞x#9dsL٩ GmtKx?Ikޫ0bo>#,zp17:El:dn&6& JZ b ҡbL|K߇R8M0S.SZqI+ Ymկ]ߗyWp8_~QBL9sg+Z72ìT5rSV?dȺ1{g ٴ 7P@obu~YNxw~. aED4]* ڳ`&Wkˉ*k(t~ KS_"]4@+'GVΔe{-[b]k P т hU8Aģu^(xM޴|I6W8` SNCK8?fxsI-Ն$Bp/Ŋv?Wj*jƱK2('#&V+v2K$6vX*GXmxNjTc4wU`QörӀF-OLOvn0P3V!fP}D YSR'У9y{~@,Ru9e4ྃX"]wpV@o4,U-F욡&ftjB_1 7pWm na@گai0zz"uؾ2AITHfy=C *M ]|wc5hH~i  $ =>tm-K9hȄcrϲY3’P7B\}Pߛ(Zۋ^؍z]ʋ(:N jSVJ݋J)P69@'8U2 KEN(%X>kr|-fsupv]ޅWyPl{j<3xNBkudύn 2F9C0e]4h:@}Sw}(3LԎE@FN"n ϱιEtϚ ȱo\e&t?LJp C!{,">ˣ$jyr7r>1Dtg eA)<~੗0QMz#8nT'1ߞ$ fI1v#HicAr<$;fF#V"k Ԋ@Mn]IŽ]PP &1ΪW  2 ̙U?>uq9&:KՄ6akҐ$ܱB#sbG+Rzn鸋qrܱ Ds,)&Zx?6 nRQD|.(8Nz{N<v)CCj-AX;ɯ9RĕK'E,oJ{.žc"}g Zw8,⋘AbO|xE($3@2Qz,q5YA\6Eʥ5KSj,_^5xsɏY^ :eO sQ4c yQtG[ZKR"oSN03@m"M6ioWBr 0 $`]jR4+b^F`?^Ő}P8٩^R2ةMB\IՇ=^>xKQbtQdfoLS8 N?v6&pw ;t7H!kZRR؈#3j0\>~=m߅+z;jen嶛a/DxIQB)t(AB82pDFN59WAD`'ANi~%{d3A>3$tQtq 7tTloMy >*;̸e1*VaI52 SyH[1ܩVCe5 K o7J@0$1Km'[q9d}:mro sS}0űMgm :z U9_v>AHp,cGUȕ\ .aSm {h)~r*J[䓷/ EAМuQn$TsU@< sۿF","|E، .}Pf.]NnwįEVWe!ȉL!r.` (vt3;uZ9)%'U`9zE ϔouϹCfQA#/P"tq)`yZ1H.{}v `8:`3t{4g^Ǧ;1AY&KCTc9ѽq CᄎĠ.q=KxªhMؼ#|,JKezY E>k1ٷ&!y|b[fG5LuM&W7˲`}nW# Cx\ `R36ӱf:7>*GYh>&_(3= ҷޚ4}j "hΝ ({t#]&.TUd)AKo1$Ǜq<\RI_ /ɵ{J|(:\ib 92hbW]e&oQsWN(V.t`LX.#g7٭qdJHBaQw*&R-3aB(L%yu|acrDR( d=:]K\h[[W7qjJ'rf?IfU楉mbiz8|6[C^K {ݍhj6VG4+[WU5 q2GTdd6O5W%K;S-#[7tR"xmɡ$k/-?YS48Q+ D}a{nv˄xbnE2&-Io nN'"YD2<)̼+f:fVy&Hhb؛i]^A2:W0t L& x:BK"ˆQx`3 r/!F'<ٻ.#B109rb$6kCGJJ'd&0G8MHCTΝ>ZDsj`" BF@]jbX!3t}:ɠ7Hbxg)=laZx*?LkǖT9s 5Ŝ'Q!͕6Qc( F wCtlC58l##Vr;]b?^b `Cᚘ},QaXap*wW0Xb8J9׊_61KE` |߻ϔ NM ׺7g2Tk[?>Wwo2+ֆҚb%|'GojnpBTScϠ5nV R20yC@dȿBY 1^kz"E|S-œP5IlZ bγ 2 H6@9V(xĵ="K&qTlK9 \ lhCeٝ 0>1 !_%Wn#IU[Sᶚ7Qu )R?q"،^nA7g~.#GnLL`SJޘ|\CY@jOXW%wd[#$99K<Ppў`BTgƫ I4y^SGޖVt=gHf*/GXJ'e"ɸeUx{j7  HWdu\z_B{?lS?m!t}(x`a=] B\[YIQsY5avrEOZ}aNƾ3K] CK5ΌhUzT߯TUvE@"J*x[VgB.j$h؎,gU:r<H](>ݖ- 0"Ox> #NcXfSu,\@%csL{7Zx`bj/>w,s ](+HP&^Y)x m'I9w>YٗLgi(Pbį{mvgIjr)5G^#\@'r}:vIY9 0-R2 }S;OdX+~bS i؊$ƭ$pҾgRꐣRO{oɐŏ^)o]I[q}y A"Z M)'r,(K:ѣj+BT"F5fHwwt_U+pqū#N^F7`txsڗU5(W5RA6YxC5ԅ0Sآ!<ʬ)}~;6B2Ʋfh(AZnD% G.Q5n>:Exl 3!cgׁL7z~H/Zc[ YP*-*T֋WGV0Dחw e!l/OmƤv>,Xk쏆TssJH"ТL DI {m.'kc$Ac&cdwX󉙅=̓vYoLC# 5;Ɖ_ɛY 4 jJg(9^쀂J%*ہPuLݞ 2-+"~ #pŻ!nxx+o 9~F*[^4up"ֳ;t&&a'<]XԌ c=T28/?g cB;?'?:cIo$3I!5GfU_ht|j)χiz-0g1(h /s( l!t0݂qA_ą!z+9qeu_.J?0r+SϴrQ H " 1q_/iVMc^3hRohz/w˙ Vڀ/ O9`."ϴ iP\NHyyMΘCP#j^^v"k%؛\kR76`7xڪ43eowF30hH(Kr'a3k`ZU ~,j>*Ʋc60 ΄R5

R)ܫԌ2QpN?5!1x!ǀG>M:EcNoIylVX1N3O\w6WQ@[ zX"pzrf20Ơ\W3 HeէUN^%As8mrM2k㇑L N Ø2yL/R@(|)X#[b8Vժ,еCYDŽk<&jA띷 sS{ıӾӉ|X91843duzcmk6T7|== -[#> x 1(ߡw 'E0U|2]St{Mڸ+oNy6+X#vS`h+LJH$#t/ /%HΟ G"V(R ~֝#bxQN**vIVQ+@h1?LjMi5n?<*.\'ʅAs Yi! Fziߌ==+,4~M@V6euqA;w;U>$Ï;D5֤e.N(6+":|\qKCj0Wѕ?PP<܉L~?PF'hbe.ie$ 0Uʠx8и)f!fйDM Yڼ r퇤Q FOy톺2E S|(*6;)ǁN /uh`VKGɝ%l X5zPsx>xtvD8D5V6 c<&geFs8nR9v:%R/^I待it7Ȓjg$Jtn"@jVeL>o4*k.&ֽ)`m#F#cC&ے+*#Z*YԖ#_M1B}YB)#&Ȗ2*Xh)ܳ󦓣L @ n7Bv{ 4Vvf #OKOB0|Q?(I9=]H>0I;ږlter8ZMjaNt[UXsz)¢e}8e38 - I0G3@] i`zR| fvi~$Q4ZRbsU!`ŀAt6dT"A@^P@y6k%;`X'6Fh}Hj34|flad DZkBt,#kc < V;4˒1tlfյ^K3dA Gj)mD äbX<'dRVfKeƺpXpcSVczQ)O$n-5&5lU#&YRR CaMe(5k5ׄ4lݘـA(j0OPADHݟԮ#ֹt?%~y]mKrR.θ@lP1<{*BYϏ!Ŷ ?# S> j'gT)Zf=#LHc6YCӴ KTgUݠa6q*iOq>B7'-Z+'́][0̲-RleX֎61zLBƗڶHāKw|ћHÕK&礈kaM2 *(5QWyx-^VXJ4ư>zՕ9+abaL~32N"/1]?g0.u2ISԽ"z{Q HBI 4Yi6^\sF}Ri\qjܦqS!R(b*{L3ZZ9*xR,9^7؁*)Bڹ2VЙL^.ozX򣭠wfEℷG +NZmӻ5taN>v*B9mGD & (bXYcbpC,r~9}29f}f6mM'薮λqMNU/58@UFWjqְfL'>8(Ҝ[KR-ՈT;6yѡ!j >A}==h< CO$A9g1_5:'+8+fX;K\*ZMBzetUN-!ui|k w\ |,g[06 xe'yq&h2=Vm$1rT*6AU 3\~kc ÈXNE\UHTE(78޾% a]ư;^̴B'z'릗BcET%#( VԂ&HK s̞_u\]>Xt*27K}G6g;ђW$Hv{t%dcL(VshCAJѭDدg'õ,gF ^);T}J qwj5*Fj1+X7Yۣ"ű4j68p{(́ "jRTurη*u ԘaK{A-"p^DH xv툐4yƶ5MUBRn~v8_B$VGqP Qyo?plF3l*s̑s.ft'PؒR)]X<5shh;<'a&TҐJo B z]T"J) 61ϥʁ=4wg8JD&pӖ1>6kj.vfAsdbd}(4_c'eً˱bFW}hXx'dr*Ѫ/^9oFcS : Z _xVʌGe R/{p!.ɝ&܉ VV_Q! c*?ߧnz!4NJڱ{G5v}y@ SeqHir<܃̛zޚP}ȱ硐td,>شL(7JݏO;io\@|*lHdT{aE2YPM֊fnb)lhgM2JlgG _:oJtHvO9t}+)/ղbB0TT !,C2Q65b0,NOx^ASkgt[^vW|B#-hn{z+ L79ɉb Yܹ7=v EL249 >˴4Xz7Ѩ)m?͋x ̲qi^zW{PHI8A_AU7C%!_uH+{2"aGQOYѦ Tf,.Ѕ8瀑0b?@@nP#\]+(<5 o*nI#;kV Wa#:S%2.NlD0r/) 4lmЄ4MR#2Uí'R@]PHؽ'EDFkr"C';-& >-(K,畊M/Dj-p4[5mJ{~W2~bRt*,V04edrRZ->8GYT.:bbz^շ@qhy e))Q=Ǫ LR[ pv/,tp5櫼N7|C^SX;հ+QSgB[7ux(U/YO'BX8\d- #K ک1$BIvVP<8j~Z4|է+_3PڇaU9\CNR6Z"=hIBP&%NBD̤|4]Itnl,a\z6.8fG{~Wh.;zf endstream endobj 82 0 obj << /Length1 1450 /Length2 6988 /Length3 0 /Length 7964 /Filter /FlateDecode >> stream xڍWuTݷAnuA@TNi;%ɋ~~q׻ּ}󜵆偞!-xx% fF@~~!^~~A|# 'bF !p``֧BB0(  K#$J w-P,p/u_@vt3 vEhQ^*.BHyxxp 7r`;klp,@#!B( C&l@Cu- X7 ]_   P0PWE` (~rA [A@y} v?'D .($/5%߯2 U;;a($ {}N05 1 VWugFE`W Ɓ"F^.9|\.@Q~;  rQ7m m!6(5l}hKB /[aPXUQ_ې+(=><@A~0PLDJz ȟG:۝i?P8e0i;b*wO*nPo_9C^bn9솺Ճ6Vj1uV0[f U `[=7;(փ#!,~݊>Aw| (@oOܪ@>^uhG:Z 1 %/S) s6m%7Vs_K OOmBB*i=xV 㙮(Ӹ)J<ʎo_@-XpSdFxu$tu20mfkS!=:^c1*n׃ՉMUiֺRl5;C1QB!e c-C݄*?_w ,uqC_nmhoɤl|t8ƲQ"=)$9Ts#uNjpƠw~OPu)z Lziƀ2*zx?VNvnwԜ踊6E_#b(b&ы޸E}wch(Ld&xkimc%u!w*Eo!HK4Q99[9~=īRz̜A+#r_lIt4DqQOmֻ馥SX=5{ɦFQw.:-Uyؒm)te|]˝R1 A|~%pt+L4*VtcJ!mLi #^bD圻|GRfSR 0]J<٤|qٯ(53zefyrY$Ŵ}iamF$_d|Z( U3K[ūžM|!( )Z1tDIUUsa7|ʼ?7ڰQAXB+qiiGGv\eh!ۍ4[.4{绥 vZyL|1#j}ʬZK#q^n<*7*æP ϴ˵P= *du. U"=@m⸼] ^M L ZNgW3VzPԸds|6Y.[. .ؚ֓Yk{l9"Kx-C%Cl2դ\ƭ\;:Gfw6Yrs1T޸YjW^ <`bESWC(iK_^d+ Nrk\ 7z90Hq=]xp6Zk -x%\\>`gpo;SfYot*sy.a'Y.Wiff;;C@O2˩}!{Nwj+7 ,g6u@O^w}BW$_Dt[ F2?'7FP- ae?jDy }w;Y 8c]:4& 'ʥ&!Gri0Uf;Ӑ.=/gGDyWv3 tZ 7>=W@%RS ULuV/Cv)VcrTV1W>uDqvҡC4& l|rASԃl{:\(S PĄQK.bOWwJ [Vރ-kb& Tt3IΉ59m&Uh=R~ctĸD6i_MĤbmȲlڟ, pYKȑJU i2"rkYk‹z5!qwoҭƻ3sWW-`Z6hSN4}4SHrG:2.#@W\]Pav$IǚYw~Nb*ض3BzoDCѳj8iI/tH\ O2q iO/d%irg3ߙa0!sP/k N* [k²a^:YG?1nC\F>ϻ,Wg-C}+tks-bfKiePL|)Y{k?; s򉢚٘5CH$AmE*~R`*o rʊ8(}03{xIpu>*l Y ڣ4WmL?fa|B]ZDlNH.mBcO!&Cgك/KΘZ̲ZY1 gJхtas kyԯrq"zZ+FV0uuLeFW t;yM7i4JBE:]LG94ٖ0$K:qtydbǟxt\]0?S3ܴoál\oRl =}<GerhQ\dGW7z?>]TP h } 3S.oc\+)G/ G3DP 3%.#q PDGlg|/XVcnN?ȷ8mm*֕V)뾥>K^h*Lqcs*vcr+j*Q~vjhh ߆< lw|M~Wug4rzAg}&dսN4obR;,ckx܉$sq MWEv6è;*ҽ3K|SR~Sh44QT?aBD\ !dX5+V&,ż>KpM˴X\?\SD{KÜD<4;Ǥ 1'Gpf2w,3Fs{v3=iPuJv]C(s3[;u BuJW7M3mBsɨ 1$.ݔgTV۬b#Y [ǢqHMSj=xOMlG^TK@ yʥ)-Zle(#Ny^xsio$ܔ*Zsj[}"}8/lo@`^b#"o_M՘=[aIa\W6`v;}YY^S[p_w^p/a w@M]:IWk^:0as1tTv*"-amN ?ey{,BRMաsODF<,cړrǽLwumeFj'q*m'y9U1MMCs>^| .tHpcaNy~ZȈ _LK~C!{ٖ'KSNlwߝq@? p2\Qd{;&HI}L}c@\Y6yѹ4~&{zg@|#Yr돉9g%UlF3A3C5( P×/UWSdrY:F̋/DR6^&LHk=/3gF+0 %As >e.V>tO$# f*1PlS%M[@0$N~5^ݬ y_]F. vS5Ң=<Ȏ,"6A1Bs6RZmӠk%RQYx#>vq#5oqՁK=vCyUDy[π&n9߁m4vLIV_-oA ϼd@ʦY3NfxC%%mfI'^A^pQ$arL/^^2yU*RRfGM^m*nɁbZc"KLk i$w(}~4CWȫZ q |uj#;)|F5ak)nC-Y/$O:͐&R/1. CT8Ssyq.kcv H_]1v0x .{SNO|H+yc«!W Q%fqŗ{KQBlEF<ޠ?E5#)>ʲ 856`k,8 Ur006 93jЍm .5 䥞o^@g R0>3?3(_֫|i~9Fb"A^~7q>f-]*…7 g"7ݎ"erF;[u >=I#ntn!Ebxy`<9^mԤ3Ț_YBD={-yoӗx*E[6r;E!ܭ|t?:XnhFyjr 鮙SUуOUʌ2 wr_bs,LǞHm,̔ǟI\`<䗱ilpŲL!ח,/և6eكnq<4=1P!4;+~e@3qR0 E7|n}n)N\m8b2Z!]9f0;tnpk<׳բōptf$gkbQ _;̑"d88Xfu'1T8-A4&o eb_sy'^%5ttW Rò /+f}"(TkгHۣ\딟 E$dO[xD}?g^н 5Ulއ/҆/>?-w+6yICw(eFkt],u8^vݵ5=Em *=*O~:眏Pc-z$Ofr״=Y3u.Ϳ WYv^Nc-ƭԲT@콥=\訞gLOfa"Sz&YB9U5w="=Mm2E6$cdFJ)Da/фԌA]V-~o=􋄕zc&E-@@~ G&Og*eǃddc|YOYJ0ں/qL\ cyY~ɞs]׸,If2^PzTA&j=Cn:'K[/hR,jH"82;ƛm!RKG (p$pנI3}#{hbo2[PnV*| 0P{)~h:௿8ƓrkCυ_c5=0P%(w9OQR"ߦzn;D^ bRW;grC&VxU Q+oE.:hp;ы>1\я ^,H4O~ s..dʩxxu5RM{YjIc]`-W-'%i%r)?Ev'LWQd_E ?I'?KZR_A/yBkٕb֨ĺd1˅K'0*[8)}^ZvHY*u$e˕FwEp\T1q'xތΔNtM\y5ۀꝘVZqXL*SMIo~ce@~7ܹi̇ɠԧ)RfI\7RrD8C,܉h7Gkξ B'ںZba^OYlңm,S~6¥8LJ~!OK_^~O@]@;X$bP 7<qx˙52c1T.­-|Ou3;9IlK["A'ocf=l# %p&'x;[o)m!;ˤʩb[:֝ :G.w7)I:L>eNيcU+'VS LQ1sp#۹c[&eLPUv5ꠍg h`~j|}SξuMpX)̳{e?P}ӛqW^3~3xD$[Jɴhq#Ў(4J ̈́#gZ pCe8Q!1'z.=P@i"-MEݫ^%'? j.Tm͜SrﲚDr<W(EXrU$UrTY#s 1"Wlsw endstream endobj 84 0 obj << /Length1 1487 /Length2 7177 /Length3 0 /Length 8183 /Filter /FlateDecode >> stream xڍwT6RRJ ( tw4 ,.Kw#tHIHH ҊH7»9{k7ʬ#k *]<`^@^SS @ +> OjE`pW@#4ƧAcpW3 @ $(@<`M^"b#0{4朿60t  4!h D3@nU]F/i/ Pq9/+@#C{BP 0)P$s:@OU r`^U;bcwA@\a;3Bs g!!%Gf?C a4s5#W5+]\hѯ`H ޽.es5;h ss*CA0 z813"f ?"EA<4[D`0fXCaDTǸvؘ#a^S~`'s lk*h^_~>  1䪺sQ' TŴB0 $;G_UWwGJο8'C]w4Fp\jCP[GUd]1 PJ0/ mm3G~b0Y 0*q¼FPn0C^/տPtRDB0X_0FPy]hL 3?$h!QP% @-e%HnmܑHTن/ }ۈ9ֆyHY{,rg˕>,;Ns|Wy홬㧮oL$ߟ"mzn*(Va!$c%{X)ɓLIX-M,[^W]t!ü.Bc͞ieWh?#J&[%a VYe@++ܬ6-}W걕IkL)er#Vkae˜=S*.猁1K%/\Ʉ/t2΀=3=x鮞j/[3Qb8և5+\v},9F|"mR%aA<`U o\˱͸UǸQ,e=?dtY:Z2wWn/N?r_lvD>_e'ꈱ;L+a0>x?GYp-L\玸XPA/1g=4 5YO]ƩNv QpmR/OoP=H|&xؒ1nbL2WŷC~{{ْL-wv Bn6gڦ^iz߀?VBi'p%xjW:R?%krmqU}mu{KZ9Ϫ!:$tƔ 䘼[k%}jOD@^O۴@.,z| 7]u;,2u>~ )F0&aYrzOP=s綈Nj! X/oRQ^􍜃wFgo~7jD._>iV;7e2WkUpyˈ:[4IdԦ]KĮqfyVCs eջN{gt)Q?y:4kf?v~-NA R3+?t=3ǗĈ"-;D}' ]4ͷ#k3avk5"z)w)$Q|)mKd$ rZ}&/]  /wm:P HESDߴT(ٕ>:݃ ٚZ,t4H H`r- Ћ #6kDDR.ᣒEν>?@PdCJjr=i0Q^["5>AΕkmE Kג; =T;Xpv~gv'e=ͭB~nΆhAbђ5y m䷡&8B/CA?, kG^2 , zwKr!8o)U$˃ ЊK,k*f'GhE=9N+Zg u׎YVc_| ytˀ)La^F[KdCTp~V"=BĊNok< I>fM`4{, 4wLb<"y7Vv00ςrƹ aGj) ڠZfN i5YHs}ױ+A_%*\w6;4g6XYi ӪbKv鯂(ҦT9Lh%5)9X^T%W5ju:o`x$x\OctNs"ȳ@JZ2X4w%tBC]-5=I}NVIV9u(lǰ27)E/ G7_ۘH $}ؚm2EmP͔&1n G;P׻OzxgҡS !7Z>_3SNIEf"^J4b v=LTW,ib6D>OϷdq0EGC<pCcF~>Aci~3ErᆒU>g:Lk&~z_!\$FYǼ(Mx5|>9{ aXDzBhpsϜk̵hV,-QKP2z[6/Ą{4wȦG7*aKЈζZS`O vͯ+0"us[\s^LO)厍݅@(`$Wy r?yȝ^:/^Vgr,}6uEJ2`Sڭ}Bo<$SEѷl\v-+4e툅;ʹ%>XD?7 d's]r}a'3 '0Z AnPfN |A7[Oc-¬t\/oC]Ѕ­<Zw?LTUgMʏb1q_:2 D\svx6"rtR;܇ޒe>>,W!C6!'hij7Hq(+?<({gAsIveύ,Cejb.+Euj'*}#fL1Q(}~€-~hg@k#+r8!Y5A2Xy? _UZiZ*+,Cf(AM4'=`DDJO h2"ʬO#m4S]e ڢd.OmD gNm XQ  "N|ːgY#i/[P<'}5sS<< GR% }I}.$BXiK;:139IQ{[4,YMB GH#PB&h1^2ۀ+b!VѼ x8 VmXF0\2l ;H놧”Y,Ǖt.bcqߣ#μJ v&۝{lT%CK͑N[?TC.h*͸5%I#Lqb초E006c|7>.ovk92mȰ2^ K$G;Mdl 06)dВm޻#^zg}1E>^:"X}'!?4- :ǚϪg|(*ƅ zZz6}|H ވeIrK15TsQ}lgJv> -(]z2tzGlN5ܵٚ:]V[B !t,k ߎy[(^'U>D2@ω@ПR,>vv*q}u0,뚛CD5uF CPkV NT=xRo.٘Ckg>q#NjPpwơA fgMC@W Z1rDNp.u߀\uˀnM 䔇@dͶ VgCP&$-IAG^K@ݬqnMZI%sy2z~jׇ*ftTc AC;EY?~M:+ )Se]Ux;+SZW OJ^6^刈 #`_,%;rM,\/>"dzH[D-2 %1͠w B.2f5"EF_>ok3r,}\%SJAjaJzTb+yD+zL[t5B)elK: iD:,HK}[U{@o[!sM1T?OrUEnCUGa[yMu<ݙ ?C#"N98nQ`yHj տQiR0uUBx[wLqɋX'# RI<0=é e#7#Wl`%}E6 zlq&EɄg%q\w N+ VW2{T3\H?&r\ [EScAvXK'`;N^Dq2Ρ%FC0~|6}4)}\o/Pn!Bș}$61#螶}yQTHlYd.'~iɯr8 |jVy6q[3x18nHVs~N91=|k=z X׀0O?^ɋ; Yla c7|}XgxLcsyҹZ(x2ͯ4h4-.C>s N}|3K@nt}q=)Y3m]ch^ݝm@0l3y:G{L͇X#СΛ;,*=i{x57 .Zgvˆ5iwfսv- mN%_>IDΖxjX7Pv+{j8HU޴fx׺ba \-fAqC,O) V֏IG.>%L|]GVU=0cP*׭5Az FSgVj `^_ržn+&c/kne5Nl> Rwɳ~U-ɸpd@,r+x.1WJZØ;q!E?d}_ /ƣ%Yi0dg@$oh-~0펽ӄҽ6U)tUFpAV3ݢEFsMʂƃ?q|VxV N bs!p'Bȇ{+ȃ>oS^G+pNm\NJ8uwp 0 “%%|~RWeێ}e:}tPk;L{57˹_GlK{s ;&g. =C9_bÒK&aa?4P3Biu'%Wj<.(Iu7CǚpZfRr )~1>f endstream endobj 86 0 obj << /Length1 1384 /Length2 6019 /Length3 0 /Length 6975 /Filter /FlateDecode >> stream xڍxwT-UDzW { :H W)RIA+iRtX9ֽܻ+k%g晽?gȯhh~X PV`a0X2B$ _ew8@X6 hx:a"&!0X_@B )\}h1z`DRRw:wGH@v`OAC G*%(-u@q`{m_:PH@e#=H[;=0Tt]?`?>ȿU P.P/i!ီ@Pg6E8CmߝC5E}x0w+CkD_eUFh_ 0 ٬k!vt4F"<*!X|p4 n +wˍ  a"@{w "`hn@: cc܃_?=t~h1%%D"ıETu tu\  Z8[E0So UEnHwwC]ξXzFaeo)hOX!("d懈Ej sC?~_RsF z(įw 6 V_0'?!VlkeñrgHD;ԗz% Cf6 (D)v@Nkb/?<ݱfٿ a$S(tcmXQ"7ʨ Nh%1WuKav֜flDұCG:z_ ?7{K dO&)&\T[RE8ẕ7\5pvϤxsPk괿.Ңa4Z2@7q,$>gUS$ٻ Е]4t?QBYN泛6w(rߟN)NZ5$tY_|)Yz1Y5ZCA:+» omm3U9KL'Hᳫ,~B ˧HVp (v8n>_0>cqAL #[Z@h3 q!X0bLKxfAII=lFk{v/km]-?_P5e<}h%{'Uc[{(|"~d~շv739u~s>u[]+i欸܈Ǡj(Ğ3N4|-=+fRw"q 5TD)V߀Ud[^ja_}G w6VЗCīg6~g$œ8~fXb::J?e .A!m!}qi-fL@ Ȓiu7[^k}=;(Z\fϤO#{n؉}Kz7-Q&U;tBpo+SqčqExuNKdn,=/JLbIMFT|SwpcuqU̾sRmaAyq(\e졏vHQY$R^ ܎g% roÛcfjŻܹgv)gv&|D?<HLL,F\9"ΩY]s&UkKS|#z7;ȵTYD]#Z;#LϺi"7{+Lx(,uxt|m;Qmzp'n^;(/ Ĵs*Jϴ}\cq?:Ψ<#?m0 i0aITfLJ ,mB:]\h.GBîjo슮̛"+* j dc Wv|oФNJ!`1բw2>$ݮX&5_6Z >[cdYKh j|?ZvvEtZE}j0tiMd 8 (=͕sq1]]>!lȝZr52-xHU("%G[<1|V{UgDzP=\`Ft6-4 ” wؒ\S[d :CŗU:pgf̶M bY$iMEEvK+.* Ì$/gUomga͔)YXvڮIW|$^2yƕlE!KY$dBQBtÎ"hGYґ~ +H 534҈х+4je67tM g"0vAYXO7U0:톩%(G<_cY9EE]Z[{1҉)~c]ۚa{m{ZNo/xK'gLtQRO f)q8s$W ׻rc}Kk^Rm[%; ?EfAIux ffkx]r%%]i3yll91 G@㖚m .yxMJv2N~I+}Iy }TDmОc Ky@ݬZ{1rǖWq1=%O\g|lgsw8DnXack*|֬JY"#y-89Ff5(^LWqړe>M„rbk,W%u#F `vxZ8ɋ1'm՞T/g6 ^:Xһ튡3/T#(s>C+QvvI6p,WCNjp(Vre[_tOr.CʦYvM8*zyVB%:n;dE7p?=}DP7.uކ㊎؆׌˾m޲aG1j!GE O9w ;3ԡSe1ULL#\>7(w!3g)=d(xDUyEE g(ۍ@ߜr_v"\f#B&o=zaG3T>aiK OnT^J~iҐwl:``JȊqjfD 1/L$lJ|1nfѡw/i?-u1g3A nIoHۺSerQU ͘I?[⿌4s x5o/ևn/ϰPj Y(Ʃ`Տ WuMkS|R LO㣹<PVkI4@oCBME ZeE%ԧ <=^aE+&h rf'ifbN<^E(Zf^M&*zHD YInԳQbR%:թ+X%AL!/o>ep6-P 31ט^Xw=p !~ j=XW!mÍ_>=7-*2 -3i2]s__粒"xoӗ=p?5t_Гõ8cJHB:j6M: F{Uen%CJk6d*-hcW-^r$ϥz`.@i1KˠsxwU\k{Sӛ&)|T?`r_#(lgɲ./ >S;z~.f/*puVev_澜XndB76tE tfJRa+ AtvHJ!s?I⼶L,~pE¬FNH̷|p :,c/T0>%&mp:+yXh+ nUyu-^y 퓦iɷȉWIg qSmLJ5];na+k L#T2vrf Z;BrURw+]HTEIժ;q3)TBOdJ=5wXep%$xi_XPlIkED/xɣy.|J㖇"l#;}8d\#\ۍ*.{vS92oɑtڒ}^s|K{ѵ7י" ,j\|Fu2]z۷Lz<<ӓιYR.șI=zìhN霧;O Xj[WN*$~E1sEkUnxՐíR&JQH֊prٻ 'Rfߓ4.ƙUWysK>Kj>Зz97FO%M^"^3Ù07Hk[ DY {qN?Lmc^ fwФQb&3B' PE(Ƃrp!;}&2})uG\᯹]<ٚcuqKR$#N:"ۯJtFhvZ`nGq1Es / H\d5ݻ9ֳ|<[)?Ҽ-_Z!0j#ƥphk0~aD˨^ $00wߛb1Ac\AkA/.xi;-2FS~*Зs;4(`]kmhrҟ؃1s,h}*@UJzSFĹD{bs;[&5,B?$p?˗FB/z"CT]GnP拽yV&)4p ýz6wSB|/$Bv2-T@DI"Wd*Cf7Z !*^c5z,%F>}v͚=^X#-ML ( p _ ~$1zZ+kJ> |"8l<] 3:};寭Oͤd;?x64{1̽B¸ݗrc''oirߛ.4)dm6Kݳ`JP2,{A"04eIF/ ZG!@kE\(ꍡRѱD/S/Sd"SⱔƜز6$iRBmOTUc6-AF^Qc"թZw\P6tӳ~(>fnV\`sw30!1f6 U/t#{|֯,U] řpp9*(W2%E1(yWwEC̪Wv_}+vҿ;CiҺ5]ntev znax 9aў@|>M#dGn#^=!JRLMd Aۤл㚸Ԏ4INB:>i's&;չaq]ZU+3ď]+4Zٳ1]aS4. &Uju4Ԥ2\ws2~rTB9lX։a˯kj876y\z~$I`W~>}SNYQBr`0tot>R]#1i5 N,ll"F8$h3RGGëlAYu}~ $zY-#tT3/ZxޥQ^]m%vHI\mi}QYB c©ks(\))UdRC er7+)}Qq5ý 0Bp@[6N?XExzgqQUK,K~cBsٽN+s;) endstream endobj 88 0 obj << /Length1 1346 /Length2 5885 /Length3 0 /Length 6801 /Filter /FlateDecode >> stream xڍwuTTm>]*% ͡A f`hA )QIii %%AFz[Y{}8F*0#\5}}U0E@ 1 ^^3 DbrQ!^8: Ǡ[(,r  `u0h'tr%@ow@ EB!h@ weBP){+SuR|^΀ À_M7_PfH?,/ p  G{|08LuCw8!"+b!h$ @ QpPSOKa' QGw@SZAO()DjRW=kaj778˓W}H,xѿH4 m4'G$A2bAE0w6q]cx}(p  Oÿ% 0!^# ':N G!(E6 G2{ʢjZVnVUU $AX ,HAdAY@zqW>@%c/ I)_QwwI(oqC[} n! m:^BpK$#=5~p mC%`Id?UaTX$,}eK^4Vu0V L\}6dP٘]&)tWDJy\SY)6\y[Ym\i[T{p!C%y=|0i^=죽R:CCŮw*A6DzŹsהg'Y yrO':dt$3I:֔v7#:>J=*^XvKI+YD/iNJar(5)1ϋ݊#zi'hwp65iF]U7L"a/s?hOinL3HQm;@g8MC)uͶ./6ӛ g?}a6x,7HIںj8@<'uC^́&`'ZhR >ng}&g[D Zs0'$у3P~܈ՂaLme:ս(=jSTCbN'eRR1YswcdzG6Bɯdh$>ZF4<*7^^HmZoGo?UUƍ UBWN5S֌|Xɝ[z*!5_a6TK1Ut4q[a"Ȅgeg &f|lP)x/er- όX!+a:gЛÍ~<#]ZM*϶΢Iux=r.>>5wcHt{zߙ@fKvؽ ]}!7v?I}HI4(ܽT-6vGxƭ>Sߧ>>ZӤ56*MqH7ͦYj(s 5!X~$\?{7X`O-m`k;oN *)zV[X¡k"9,Ɋ$۱:W.k*0_lNa^2GʶS[?xr(2|%xO+$b5^ifwE{k8eG+/k#}lk^ @4f-VIM`٥!,8KK_%.pQvo.%GVצaoVrԹ#[{**./8+~騌4ʓ71xbi^ݒ^fˣC.o \爑蘪 `Ε+@S8tu? / uKUN&/~,x] qO4+3ܿvFA*jr9,j3w vdEV"@Uy\ʛzU#!}0jo@qq Uwܫơw+hCѨң \҉|'UQfDL??J^{%dM2%n*Nen yNFbv3ʺTLW9#{!,6)4;l77 a_=ЕCeqYr8p2HSH7gmbSmX~YTV`⡫y> qѼxן _gx`ҞxߘnpO/JIǒO3Lv,u&-]8 Ζ HgM9vA{&IĨ幷O(jO`9{&ꙟ{+kmK+}OF9wѕԺgrQw'"8e/9VuJБ^q۸{U:zQtԌ`JcgKE=iV*X,&Vվ2%qwV.J}e9D!;&zmk&{E}\S7te # $ˋ5툾 *wwV"ev&ZnI3xG[Y2鱛.cxʽ'H׏oĭVeq܀׽L*<ֲۮ7"9f (,Yrsx %,!2S4ltM6F(-B3y{-,s"{RR.VDkZ]%9W#%'z].I+?@jnglxXP-, {o˪]Ts^V]łW5\DS ?-)D/[Ik'&,ǻ:? ƠWߗ$k$wu6h K(W {1kes{y=]rdh|~Rqrj~hj(uBArEwV$McמRe+)Ŧ1J CfUzL9ʹ/ z{(o}ЄOAodbŌiI6wYA=M"g[!Qn5o4=; Cer w`T> stream xڌPڲ wwkpwww-$w 4kpG>${E׺W(ITL Ff 3R d Rb`󗁨3&3;d\m,lN<Vff1tpY2@xJQGOg+ K[1ps lt25,voMmV@ Ag 9013۹0:8[ܭ@ h]0@oe5K+ wcg M`ke wyp7:ޒT@57F@V8:9{Z[̭lE 9F`lo$o<Sg+G ~y벸|bV@ӷ{2{6s+{3E:2[9c&#@'Ԓwx5OG?J |oE}́o]݀+o&x)`M 4.6{,?6^f_&m UM1u+ND ```o|w%c/_i{s}k?@X oS r=ffӷ_,G;ېIG6к@m &ߥY_4m-lF+ +iW{lJ.Vjڼ=.o# 9;c;;{¿]qYv @o.|o$[/qD0!n3I$+I[>?AeP/qEQCoQT;IU2h4Kod޲%7%c2 ߺӯ6 J2o!oÿ·[W7-ÿhśo} ZeJޚeW%o+~}6Kvv?7_Ƿo${[9菔?_8i;[ݎ.8;:-xKcY:L w/|;_W 7uu~蟧U/;Xׅ3J D[|#4ҋ#Ns-L}&5A0NeGdp!ОϳF W.\'W.d|;~I?9eʾ3DG~3ɚ%1G?@Aϙ|%=f+d|?VҍGKq>6M-r,]R:񕯈$>e5J%Ҿmle77 BM0P[ڌiLUfeth[.s"i[x?682~Lii"8 Hh^R7bu'( 4ޭ D_vKz2yg.df#ɑsٷ\ssm]?5Sդ+ϒM(#M^xϧje:`lpf%6X'\6Edߏ O{Ɵmʤ' "7f7"X"#>}T vQL/ݙ3!?Uq#kAT.~r/.Z= Y_+ë tZסxG1u3e aH ]>滾;ߦw(m+x9 lHvү6i"^#Z݅ k3f'c"0l̘'RRu":lm,*ukr~nm0 1p#'ΤyCxVՔ٤ rpju~ӒFjE¾ᛣIPPb# aEF|FAfZx'*{G:sH:-DbwmYUYܣzQYopQxb"Y}3)UJ- 8ݸdzȻ!|X<ٱ*VJDj[14zW? ~\uܰYmzʧ_&J6 dMiqMn[*Kw>OzV;vHk5Sm(XV*d 9r"3^Cpˢ5,/Tᔔ9G;~v(kz}k}UߡoPe,(m O4O# 2bl'mP:H$WΞCҝx:[뮄:~f]Ra{W!f:geXM5L&rd/Ԭ9nՄy)Q1L^Fu_m8k0_O2lႍ,[*o4䭋ZPdR߅py,:ģj8#bϤhmu yrtI`YI\$6y혢/LI]kAFBRdT޴o*'>jïǿ)D& +qgשٖ֢'k{eiA\7{cve1?@9FQ˗"@i {dXʂByBl/%XY)n9/GBwZNg!jSϮ6]Pk9n1'Aa#$ ~JlT hX970Y?>5.Ї]1.T:}&ںϞ%NKfե6Qs L!8yXRQQHoSXFM3=f{MP T3 i *9>.H[ D~ \#MtC^%n$[u"^Ua9 ͶB]_/ir'Z/}!-䩪wVyo 2XGF|!T|X7HxqIBh9׉j`/,RHXA>92Ep0t3/{07ڈfDV$lԳJR/x`ۥ<cS}c%S4/*5k]LGy}8 (D+֊ҡD5٨|N [9Q~8~ SB@)/QUn%>?b*8[LhH-L#,q+pD0g`mqTrיjvhu߮_%ИioI'GIgagRW?f,IBȯfZ,t?Yi3Su~4+iKMsCFCNhÎ _ۘˌ@ nGqr XMcXΛIZJ&_NҚOJxe55 HRJ{j tDž%DQ[6pe\)Lپs1CmJZqd2)2iܗm#9[di2Z>4,McsvcBTY+gHރKm<@Urx%2jQK@4Ugo5=B Yp  im4i.c5!_1Z^1bw#2j}߬%w=;z❘-^z?h|`hyha3cs2y*ԩӏyM.YKg#u۩ڿBSeT <$|qp=g ߺ ͐ѣQ?u[~G4cM$ړ2@AmJxSS&a-jgAJh56|2٦E8ٍ:`Ȏz\uWmlCv>h}aAS+d]K# )je3zl~S-K}ᣘ#4ݞy%CЙѢ7ЅCmNg%lAhVk}g'ѵQĮoxb͈aT 4cXzLV‘VIn/ܲx!hjZ# MNC4ɯ֨r_ʤM}},)Ķ1'{c۴:+tx&' 2Y.mC`FwB>'$X ˜?=Ћ"t'"Pwg@ yY]Z=D@;lIa9=7rNUd(z@>)#4p#ę(9Z׈K`۷AO柕GJLCV;Cࢗõ{M_YY~umȝNz\k)x>lq.Ū^">pn3$tLU?C- pB;Xx&e ZR)[ +Y~`׽ˏGni_ۯϏtKZ'_QHˬ~@^&%<:^A"$| HW }:Y![*6'*W/?3MRߜKiHc`UHn0:5A܀YF TWxn9Bִ|F #~[S 19V-/8jJPd373qjzϷ Dip>G*1 $)YWT,ea^$lW$cSa{e?:^.>Ars E<esv_zbUXu͚d2V뱉+ /MOqQ|:Y3_"^dzeI|.B'4cc3S2CtW{x!WMn(7kNVET9?ԃEeg[jBԽDCWbED%`*:Wi{}qN6%0b gqz}D{Ȕe?(ˀYC)rJL:~└҇jS]:tqaO9/X)mAXl /y;Oz:"qvNW˩ůdsQ Ю\%VѡYSlp_t!@ g_jU:6Jעكۂ@:F!7a'G\F<]׮ݽآ'h]1dK]lQ*$wV9>//WF'rvH-yhß2m DQRg?ƦoPf "v[ l4ܢSuߏut4ĨrCNd鴽XlrG jk_y,|)$oAߕK5 kA.]qjȈl |YO<=~C=3ځi3'`;y7 )2sU(I޸Xpp92K !tdM "HA9>&mV<7`e4Sm쑺0WjiH8baYعjf"dQ(Q]T&G9W}mv qUe\! !ˈ+Ink$KJtڪNS,n왢g*=Y(=4=B&ؓrtBA(:F#5,P)]Ob`aUxf5,=OwL%&10j,rE'M*:d%u(#(eR5#%ŠN1x!;2+ ?m(yXx ^3 YNھfvyit(ϔ]o{Mɗ$?C^#,>'Tr|)gAy۹:C@wO]IQ0zq0?C -fHvHQ> & F"v)s('_!Rd:qf#nў,d(/-c.t .󑸰u";1]CpL?N=za&:G3LYhӳEɀѠz|˛X]֔OJ|sH+ovN%zc}L^fs}wB{L^b&*9&`~K$4Dͩ{MH|_/d?@OFRdupjeswegQ孱 HD[dk(t pk\kî+%z[KpTWt[ a&+RIeĝm=Q}o* \lP]SVTաh3|Ip)2'Ͽ*idΝ;s.* @|MS/w:)/_;3/|فZB~vS۔L3f`$.k@iS ӊ c ifë:͟dIR{PK%M8ݶIpKk?Fl_p2DPzu~we:'7| rז֊Qo0YGJrX㫟/Ҿ6Ro%K˨~eҏ55 d^h:*N&$½F(4L, lDW'S?'ykz5rS<ꑂ-~9KBE|R0+-9f7Ł&Sr!%,n4i=*5)[ʯrC-pO[r!w]j{Ŗ[UeU/qrW}c~_˸d[?Vdx012꧖g-| 'RRwS@-XYfA޷'Y˴ij~8ILƳf}{5],̖^7Y]Ln0RCt1dUmo@?S,ȵ)ȕM;ga`p =y7n± SCTZ'$%B&;tĊ75/bʼnr+ĜYvܩCܭN0Iiy?]G_7OOlbt^Ei<*ok:?WERKpKmqG`y~%fM&:DQjIRReDsUZb2OLX2EI36*Q}hi#qkf(6EVNI! @n_|ty %Y7x08C=2^Cy5 #rڪ?,$lu⣐MyBa@!TܕfV`t/#lfʉQts1Iuͽ-YIs8WrKuVШQ:hl6f%@ӹ{{:U]5 i[mL'&C"pm>׭pƗșinq5C5Sg]AZi{xC&y/YYK^"fA΄2AdP0Q(fIe\tFAmpWrg?45췵3=X5.^'E4/ӛ6HplJI=z5>|*lh:o~d*(4EaY!f81[LdOeiB+8Xq2Dĩ7nw`,lH+@>Ni~kg d}ʼe)+_Ig(=1Wٯo0PlJr|ns!:T4B"P?(Rv7z G|}$񒽌#vⓜ],Xk}+}' 9&ҙ46ɔ otp!!5J,o r h@XUFXCqRb:P|yMAU;Vq-W3%,]kK$Ն 1'`DXΊ52Ok˪&=j0-5H4®U_̟?YQρNnzu n04W3 f# 1Iibν\Ldz7qӠ0̞wT3Jk-&b0$)cE!83-BzH+ wtaowÏ٤>NtkuөGѺbHBO&ykSŽHUs|T}Rz,:?k-ri3>˛smTIf47D&\̙0l >G!BfwƇ8}xcwc~B9 " ڌEWlt٤W6P==iy%BR;,)ҽ}5#S,Z%=IȎkccѴCi'o Z0~YzcūN*Ȣ\+"  Z4Ŏq{1ĜNF6^ǨSb6+jQPr[H!V-)i%F~{]L[RgOˤ\U=UPۊ/'Ɛ0r[ͨNpfRNH&߯XjM~‘|4Of=2na?ӕTlTLWKXiP,6L)W>n*,ĠQ0>oI+Ӣ̴-TCcg[K^A; KNſI)r鳷BE;jjB\d}c\d̏|PX]rWJ">ܸ_87i=e3 0R! g_5c1r]68e[k̓q]E)̖Jtj#ҹ#ֺ(FM`Fڵ3I3/uQ}/)W&\QVf:NQUtۣ 3&UqhFēN&kTF"i^-9 鞠:45t4-adX8$ _td)Z.)jgŊ#qx"5%;Ժ?wKr!w阑jF߮]еG^*xcD .6"s+C5>Jo 0=pqfq܉Ӂ|4}uDiX ic/Zn FgS*v ܞmP?LbCi^0:H-|.akh+CE}ײH.Iz1=ܬʂh<B&%)˴`C4ɦnbabɔU` Ʈv޻iQgy@j[zF|MNya@|*?ND8vM%f<KPHV.rR{֬|s~Dᯟr)pqh* 2sn]",\%T8ԔSfO~P]e3Rg) .͢m 6i)_cUsLh6!M~%`~Z3YGq:,VlQʙMs>*,+֖K/MFJ>)KWU 4+e^rnE9S{UrSHYB츠)_u}z']hjlm&yHCvMXbFNŗS{}r@-p%>c"KrB5+U3=@nC54ZhdԣYYٱZN e?Gg<#&ȥac|!(OM+8Ą .{Q+ɤ<8LTXǧ!!8+6n5}ݡ!p \œwr*=*P'ʧ6kS= o#xz9J6IHu_i9a+Vt:a)5F e(G;k=< ;V¯M@-e_[-⫾.?~8VJHl"ڐEb:C :\ܡ!RΙ8ޑ3.SiBPМ%HSC~˶eO۶zժ?H64tpW3Dv(s^O<۔ !3Czd7 $p2P2)1~Mxy>E;E[cefzӾ>`UGf/=yyq0 oS[힟@u#0_&?<dƞɪ}/%Bn f9 ~|C3U |-:L?rtͱDt]Y!}C2lkkEjYe4M-פ}r \%普w{lrD@rjO)-H{#r_za6&ݟfsE}Ua_dLH*{QSѮLH"E+Qby qwK)7 9dOHp΍ɳ&5DLg-!dd)ь1YrrMTvnuOimȀOI(S=u.|e]Z"ݴqG$9yjOC kvc[%K6wNkMZ#BѝJU3^9 F4(Jb`;$OQ=~j2SGLaܞ6拮nxF=VS^9}OeX q$P+ms7> N^R (L Df)UXFes${/SR>;ֲXy w?x}0IR;¯>g Y=ĪU+˥:eG>.L!F#v0@$V TJ97YI2 C`<ѭ4l: 6QkrX̙io(xN cYmy-a5ŕR/kNѸKa`w~}-1s K2"o\XfVg#We%zTUwH3%j1l3:P 4݅ )/g00\;p:NELJ+^KDX=2p>>ַ-bqKZ"۟N6Lo^Ֆ.iEkGM4`!` mGqV`O%Dz[2<"LNaYELd]bXQR2>KOiWXbEizS"Vn94`a|H~ד-6޽}͏f;q7SPME^vL ݏ8 S#WW3>eB:XrM} cd/u,S#Ƚr$ryƩx.#SԐ瀔)pCu 'z48貳99R'K,S!(?,rKSlxrk}f~K6fW7%[rV o|iL#Hk]"R+A/Pm[SONO(uM$~h*/oAFM {#}#Jݍ+ I ߡD)t f閭iHpDN5`:IrН=>fB=r^zHt[RY!L\'\ZϴccU%b'8=TC9ɦfIt"' 8vwqhJ5"\Y%訰bVm Cp!:/^NDqA,Avd>JSљ1~4S_F5]Vo [֚^$ =ħ4gu-*kzmf~~'d) .*etHԮT,҈P1J9[\C(HUҞv:z##̏MtY[:t'FζNXI}N$7gȴklL IMgJ$\gU~7 Rm{z[of嶶ka;(͹n@aah= K Jy5Ǘ2"d_J9PS%HNhl_s*R#Xp9#0朏_EM]$ 9f~O.Wp_oI5y|_30."~Ѥ.ޤyȆ)Eh)zG xi֒ Rg^~8>6-PniZKMC1H"H>bTJ@p+E ?S6 >SWgzbMgg%z//- +NGr pgϤMXQZkX'dh`ȭ.N~ZnsNMA9U RvI"%|'q6'PJǥ,@7O pB^G],ēnP8ə}Փ*RA^a\)܎:0rMo?5[+هpU@9pAk@q3"N@v\'Qu'{"7(Yft<>ͬbǵ[i|aRLw.7^GF%;?MyU\~dKST_ 6'ӶnjgN z3M:+^a]SF_jd:C⩟5T//щ +ess B#Q #rvc=1]Ǫg ~j\q%KyhVQX<09?7XY,>wQ ݲw fip抾K1n}eKS?2l.{0ڊ@# FyЈ}^H ꫀ17+diŇ^'kRñ^LjŢ> 7mriZdj uoß( P08q{qE=[&By,„Lj%:V*1]/cP[X0Օ ۑ11UcȅصK@s>lJ=Dbe3ݕ>@ v7w {O0[+*}/[Bd[ nVmBbUW+~"ˢ{tgv ;Sg"Zl>l7UVIH:m7|96"ޥݜ < _]!ЎxDxjHmn` f7:I+֔[4xpKa'wO? ;{Pp&fFݓwۛYɕ*RF& : :=oQ|(m)T…1^S؄rcuɹ\kh,;3TH3wXdw[U(Ԭid,ZX&q9U`[O6=zb5ý^ǀbbV%vwB}$=ُ5sNHԂn.@Ӟ0,8Rȟʼn۞MteJs'Ona7 U7\Z-; A=rƩ(9f <qD+C3v@:b9= 4㩃Udvh2;L0 xn>x*N=2$WXp] Bg]ʰ]c2Ѽ r-ݟAN{^MҠZ "6֐!Wg }'3(ᓅ^q߯"&pYjKtRu3<oRţHN,=%7W +zҀB.ܟQb3+jϞF=?͗Z5H4ŔCJrݚY[^B|X-dkZ&Aº K\F(F]aVhz%3y1DIp|:%/:Vp'ͷyee5ɕk?|Ï #rԖ?.@9®xv1;R=E a3TsBBjtQaˆdzzVJ,Yzdyo%gБSo9I)&/[Tlnm<~5a7*&l-x3@^7IUfќr|{ cCwU+ ^arߛ~xA #>VV]HI׫ӀTBhP38~1ф&f)BFy[>YC'+vʥێ)z0~^:8?&''0?QAe\ǏZ"M@CA#.'/ `V] ?}C '60H(OoO4gn^?`0cEB95cN_ΤG ިWO#ӽ "}[l̉Xdج+`\;tߪҐj8c/=`Pkfw&A4tmoMbrm۽L(Y)[J % Z-=pwb@A^:Qf+$ }LyͅsoWCp[sc@^5ϯqWل,.哾S@M2qC`5x;ޓߔyIU`$Gj ,⢸^Τllӆq&rDmw)F}M{@*b>UJ2'Ye;6 ɿIrX1# OC)y %HݏA]f<m*Nʪs?A`+3!VN8Q*4nӱ. ra4lgߢbFJ endstream endobj 92 0 obj << /Length1 1373 /Length2 6090 /Length3 0 /Length 7029 /Filter /FlateDecode >> stream xڍvTl7%1:I(nI 1 ch$$QA@$$.%E@RywW_}~uc3QUg\ ŠB@uCS ,!XO_Z8F/:uP,z!@.X(+<08rc@3]m/8/gD_ "w'BCa04 D\.O8𶖁6+;B=}x u;i R5B= <Oɚ(gu4 Ga}@`0G: P.GpY޾p]=*tp,P ȁpo << B{]#C.p_x) 3:](pd1]0x ';<(Y.HZ[B68Qqef1"X] (W[W~o_obG,(ۂ0BoGUBxb7DoWK_t5;#|mBPEz>Z1 s *-~}( /U0ODο%.% b0@~xI i ` H CB.h >% [Gab0x8 aI4=Wr)Zf 1-4d/s"1Gt5Uf/pobRMςRLGWS#mpQp_x߉ n$l1.d<驘=jRZhEmD8 VR(^C%^0 d+Qg t2幹O; +!Ç8 =O⹢q[ߒ8vڡK2 W}\nQ6 Dcf2]TUyIvp\ uyΟɨy|uI:.\:4=̃?nn jnj-7=. 5\<~UO9s}e}6aHB@: G!ZX1"-(q;E}Z5eРrz-i,l%mղݚr1SB sZmB8$)UrI1՝2v/GJފc{vmf |[˃(~)ҦPݯt/}5$Lȏ2l\}%6r:JGN~%@8>.X-z˰f7*sonή?,ʧ?tXFԐ!uxNMg@ϖFy=iK3n3CHxN~MsL`xm6agA8!ZЅ@q.ȧv!@+LkFm2~ϊe- ; , O}]F64]a4M:՛ @G+&IsFROr!_q*;0Z]ǹmUJM3 ΊMQc_SNF%ED"ߎ5+L㖷24jO+9kD 4w| $o"Dž8a#Ӌ؛zg]1<>^|HNTQ|ƽjHp8~D/g;oI*oސ^|bHC)پˡ3+~_: )Ip^ߓ{(Ux4ei zV[b[hwe9&Ӳ_>9.X4VwO&S ؜*> g}YsrN%XA{]c*cYJŏ4_^? AxBCy޷g{(rGBtY!NvV컘WCJ+ܒ7ȵ{1Ŷe4 %)Ԅ1jɰ|~̅o˃qlk]#fCpj7~`d.&sC'-M7-*2tS]mepWץ>D,OWniLT@FFD{kqOm.pf&P4J_M|EtjqAyM⊒UMTj~#.'1HcH,.[(vKl4i$1&DϘ)6< n˛][$g.7̓?>n~`Go*q/͎;*w5We`GuX5Zv("]zN|Hsu8nmrF^ɯs:Μ]~G[qU+ҟy ޥl]5jkܟ5ѻL&ܤҪ2#ygWxyAԶ._W}`2[hV%!Ҥׅx0;m lew|CwVs k1md!2U*f[GyYa;݌:# gD^`V gOl}wX`[^jo L6Zaumu}x_p$t\1x`Wcؓ`ܫ[l<{ySPen~ƀ(=4{ޕnһ6gצ,e9Ijl,_n Onkw^ޥ>Ǔt%G^w~_8?_֢[לT>͒@)5;J?v~ jcSۏ$SLʁJ5@+联Z=]Hxt50ꨢ\_|J>kdsۇEW*e'M}eRt8ݖ)"%W#_G|يVWlW;Q)zcK_ pu ;- D? gKB([;}r mEJ4>sYo0 ݼjl3r m#^lS4)JlٞPxy@c:xFf̽$K *!j eȀIe^+qzo3i);\bG?ӓ o*(>s?@2*1u>M NI6tB:S PBq3EKx_K^抠-/WCI\Ow8׼NK\AV EwMSG'gP;bەQ{m=X~y кDP˲B'XꝮVKZ&=߽'[vody_=0֛i27KUΝٵx/~MUCgiKyD%,, Wk;{ME^${3t\{͌TfKI{4'-Ʒ1Ē!ܳTŎFm`JHfj Ki Sh1z/>ɉ BJ{2 j~: 3WD m{1 ӷ1$桳! cR%0:߯:|^4ĵX: ;hFJMh(f7ɬE_6 鐤=!B(ټ nER 9N6 2_q|=9k^LuЉ#nf&/W6$~ ̣#̢{u=Gb# >=\/. ~esmZ ә[{wZ ~ p[<7?as:YgAh' {!Y/̻|,6nFdjxߨjK)q.יn9o gLvt옇麵j#ҫ3^4"rli ԣ3ˀkbgӃRk-ρu_2)K3&C)!1J66΁~ۅefR%|*\-ռJ՗ #^8UVWsJ`u T>&gb^pj娑dK{ugke"Kmi{ҷP_) EbVY-F] :qto/guxB3hFP%G`t0kˠ -䍝hFWeYOMTq:&[ovt% gu۬!'?gBCՊ.`)(p.iG:I4.#dŽdٖحbԝXpaAybFP,r%[L-x\^-eV吔UfޟIyM>ЪWgC?)$K|FTop\NSܳE}8 > ȅ9J*~|"UMcu%F%\A ]Uo*$Hh$ve{E6UY$erXIX!|?Fyj5`eBEd}Xܭr3Rl[5xZ=J?g^ 1JұI4B.c?3{ʽgìKmϝw#zQ.l[]\Rt|ҍKɭuB!,e>ʒ_%g>2>p |mS |^K-/kUj_[vd~Q36[Id<@ )=)5Vxv׫S(ȪpEHs\`~wdpu-.F>CY~MUq*kw ӚӖdZ,#9 wҎkz o~F_vzP܏X lzh׋LsNsig#:0{~D^ΌUP] Y,gu7]DhUrzb;@}M墄. _sO=yQ$% ewj:ԑ6#ٴ1+˥W|p{7UV^0k'لZNTC.#AlDu,"Gn,p|ωM0fy&)+n㽝pa+`Bե,S}w۷'[э/z!slUj944! JnX*ӝ}IP-GU):=@?[|;bL#Ykv/3|kWDtY h՗NZ!3k&5c:$j &.k@ǽVPfH)~ S#^ݭ*y}G$D B*^t7J5kǪ/q9:F1=P.O`$D,X-\:~⥙_mK BCL1+4:JJ9l7"P~g)8{n2ɞ N⑝4'B6RMT.XJVs09L,ųhnW'qG.Y,Dݟo;B=! &meE4E1RTmw$u[3xtGB<vMS㐟߹R.ѱ$CDE%~zKg?1P endstream endobj 94 0 obj << /Length1 1697 /Length2 9093 /Length3 0 /Length 10188 /Filter /FlateDecode >> stream xڍvUT\- $-@p (PHݝ$A$<@Gv}Qc:s=FEU j X9؀ Eu  b914 0k? :-#j+/d4=Qy'kWOp!B&3"@j vĠڹ9@,,aO `18XX;@@&E%)#A0 dgwqqa3qd:X0\ 0K 6ndb96 :%O:b<! "'[3)?@]Nl'88߁ ,66v&n[ 9 PV`X&f&֎Ч&&k'śT&O=ա#bsdsXw5؀ma듄8AO;z!f[1sc״;$b=0Ya t`{d;'oS^vP;S+`/9 98IoO:3ZCU)j0nqq+`rxx^HW!Z*gkYFf翄ל0;I`?z7AOo%Q?5I;Y[`b@4f`? `gž:C0~-/]` m?n /_Pnx h7>{lO +>Ǔ_q</ ` >m?)<w! aMCABj?\Wn suj|tƈ`CD򾄜;?1SReRRQ>(\*彀x+*@|PCJX'h .{ndi~҉H A }(vvQȩ*Еw~PVDkZ'cʷ7a6^=h7 ՞ sl} ,~眥jN1Ka>U/a GC/" \DF&>NcXXr+9坐e8?4~Q)5QP`Y=@Cҟֱ[ҼIuVq0z}5v,ʒoM(T8ԡyn81FJGf6i]eJ[[7ᘏl10kq 7PfC/gVr%J" zeLO/UC ENl$ >;HNLgMbdTl8םuj&^YV_&N*I\:ot;ut569.=2c S4|y!ĝ1^w6XbPmVZJ !HU3' r+U"b }69zN~WX(Do2Q- ]w`uTTxB!PɃV"A=f2Ahli`ںz `@jryc_\4G:x߃~ANwޯeGwrsx^lֆ+>K`+:5xaᢇh4"l)*e޺Z=ŵ4_dъKQM 7g Hgz 8  wE(?9^<%S1- <\_KQ^ZJ5om`L]l!'ۯYgn f~qi䪜J C^}4amA%^x`̭+-wn+E\w"PV%ט rdU}-[sTt:ڮ"$M!ɻ3/Yad%M>P{&}Ook!δ~H2f_*e[Q~9 Xp'T5r*285( ]}(W>G5_kf Gݩh$ok5C: D4ϳK ^BC 9?Y4dw: /ʽ+Ov8U5>枑? [lTQ:7(O*ͩi ` ;NV-^BXLuT$͚}@Wrr+t LDiiOdh}#B&4#@2T _}ͱtΕ{8Xn}ObzC(0Z?,^ZG9cy{WT>8ur#3;K~}/'i鶩TNSf߸Y㘵5&pjzPvTq>>D"H6Gҵ=Sek9IϚOW& ׬&BB8E ;Uxհ 9 q8Z:ő;|٭j$J_i- @n *X/"D]jZNV>ED]pN2rc8ޑ=4Ng=ZpLM/ Mƭ(Ei浜$_>Dip_kaXxV$չM9W.1jB^x\#͢!gxH6Α!9ѺTU2R~+ >W]+:rv"ݖ,''JwiLb]/|[/0=vfQLJl.dJ(-&RomdBۤCAj\zDŭZ2G`6e*%ի/m _d+^~Oʼ, (h~L#k밇p@ <짏b+pH*ߵ􁨞Y& 8NaA9sfJ"<isVh!0@ rG¡W\w,m< GJ9H4M+dc'R[{bүѧMIˋqhhU&gJlpCr0k.F*oi!0ݛuTofzΖTjf #!~ĠNegIS:p>x^`ME(EjJuy -->uʨ`zX#…,}kD*']3i$ {cWky;Fd4Dvz}?#)4 !*X ɀ&ɤX',j̑*{7 C>vS(@_D6`ۍ~tjv^^n580s#5۬=l(jUxkuuO|dJႁ`-eS:(ω˽U,?@z>fE!z@qHP, fYT NA_[gh|Etׯ%>:,w}5.T3)\NT}W*Ywڟ>y3޿:|ËLlFD%LkTFIB*Ƃj\%Ws1Iz?H*m|-( m7}^x}#-`(SbHlzʆ=z ~D B1a\E*q쩢W<no:^N$b/C\7ygn*Q A.ofq@A8ڏ akOɎY9Cѡ\(Mg L%ESs{^pRWU^eұu\vŝT? ':9zí?F7oZ]4`-˜xEU mm&˸Pڙ_ ,W }Z]:]zKI7 ;d˧ֶ][s>e u':ؾ}|NyXTXn͓Yw_wq`ػC:Zfto<_! Q!K!#duF֦P{֙(;c~Ą+v/dypȶkVZ0bzrV綷ozB <\F{Sha!/MRXA-xW LpqȰCI=E`잽|N .s9~QP:R>eV{^G)oZ! XWtkPT(i;9eP.Z\1x>PR(ָK ;Qz鎯X/r 2y + ^o4/fHjEFpmKq+nWSو E'=$(7/ؑۧO(el[ Pݬ-GߺO=d{7NmMϵyY?8Xqhea,s] ~og% Z*j #DNerx UacM @O8!QlxdQc8j$8bpͿ҅STҧa!ބE/Z]7r䲞J&`Qa흊U^)I[YD2d`xȿz*o8l,{ؗ ׄn@I'I~-s.Jh+$S.&!Q]cg|Eɰ5O岳\r?|\XYZ"`W+8!gohԻqxNŘ<\_cGD6H!*q2!ᰵfV .7MD3[58pڗw6xzcZ|k{cncDlў}=h^Q{ o#&1-4g@ͰǞ GF|~<,R;بm1*L ,Ha6i3WCf:*Q7_NNH %Lucwe{Zqf@7C@K`s 񻯣b} IavpIV!ܟsHrg+K )<1cUmx\VB.b8Cۧ)}#CB<7ݾ>m8}X12BS**`SǓe3%h@hL&ة1Sᓃ :[6R|U|6ֺy5iߓsF>=y)ΒkHyƸWcqX{3%[W2d{}ƚ_Ʌ^sηqs0~*y9aku~v6-Kir<$G.:JŪ !|,RrԠzsNKX#ˉw}Fk +!'PH:!ÿ0!;3}]@JEL[N3th):Ȭت}[+DRͥ1F,.% ;rNt(Jʼn>AS_PC?ΡNLCħ$?ȟg&kϊ["0v2~5p.AQ ~D,(0Cs\(sM W`d.È i#:pٲDh$Q#Mv~d^Y_NHMH4Yow8!E7L;IpBh: endstream endobj 96 0 obj << /Length1 1379 /Length2 5903 /Length3 0 /Length 6850 /Filter /FlateDecode >> stream xڍxTSۺ5"wkҥޛH !@HRIo)Qt Ҥ+"Ͻ㽑1o~m9#FN(G e ňo;1 G!e c650 G!:^HI1 Po S;E:($M̭;`uA )ew'F;" p()`0>>>"`wY_ǸLh7 kdg4bn =@hl Vj =ȿz6+ݟ_`Fj`|1B0@`o0v~h( ̇x=0h4kF_i۬tREC4PvD {#`p5G{A`&ۜPFRR@}!. y@;3x<0 8 !@4(?\@'8p:ÑΎ5Ca >2 DEt,5T/  ,&@ $@JJ#V CdjO|g.P߿~(`@gWݑ?,s0X裰Z@7tNp/jcX5(#Gk}NFp /e77 5B0( |XAܰw4]PYW A9$ #ƞ5v%aUMf3`(O_ JD 7e^4 /̢ r#:딙}7G VVb%0{UnrVG]Pp+g(y\q:dcVr|TˇR=[>_u̘x=G\a{ T6^fW g*qm߿;XHV&_#$e69WGET"==gAjt@{WjMoP=G,9fDIZRb\sp:g~Gӱ~OϬp}`8wN٦#?Z~+A핲"ę7EVFzWbb7kZ+PZ z)F]/v酥;IzQAVk4wLO{z&.gl_Jkƃ綀Ғ>o *\6ΐwtPd,Gs~ 6h[A^[i84}3[ _M(c-岺|RUxSF=}In@ׯA`Mr^zױ/~53a&ERfMcbyj0Mw[~bOC\Zn;{Uߚӳ'M{ϗ3M+ ҍwQ;[Fv Y> ԥNCZn|3pIlCF ݱQ4COֵޯm [ϳq*eiGRY6My:<#4b^xҰ!0!M6G/dBk*Hǘm6H"L~ƥQᭆ@SdoDh_?>>DMQ;Q>;tr`!-U=[^|6L&Zdnm7CyUJ怔wF(Gpf IdzY ?x16=}f7'nȖRJ4im͎?l/LzZiaa.ӔP.q;4XY(KREreNTX?pV`T88( zr`H`:CK6U<ZZo0PIjPمr0:jPLYm16 ȶ=V"=8r"R3]($F{ؗiI2p{x|)yJnv<e]V: Օ;!{ha[>_SU;,ćc>cT2~hVٟo:oo8Vnv3 6epIZfGO>%S_˓xq8f:6GOm|̯ ~%9׈]9+5,yOr'N+0CNh­X6Y<ИԐְKbr83n'6MUwhlj#A_Wf4l(ˣLM\f, /M ^ޜh)+f!ޥ4;rHqdI>'‚|&P2}˸4:V/+0]%gwM#VRnόzFƨ]c-Lm~tXyp5(*|FZN ~L,=_(F ZX +q[b`;K'9'z?qY6VZ(»bK~eLJ6Y~|x썳0cqmdoE.a%gF^/C <~Tr5?=u-l!D0z.}W;.xY0uq{gºs*='+ P)K1*!#VR gh6뮱o ֠u}{ DfczI,byyNJrp:$W?3~g fxyڟ6LHN Oc}#KYNHȭM""f$ПR*{ KniVLE=m?`_S[16Yn K*Zpi )YL9 e޷ڵ0ؑ-+0 I жnO,*8 Z.Y4/=~̺tfÌYGeoVҒ ;5xM,N޻/4Q98IXD&cw]NƾHle%ml  :{( tT :C9< EȎF93P(c+%qab&3 yݘu8jT_i<,^fLӭfqPF.U"j;/z=Y'y*Y9UT\DU4 FЬizu'e6_y;| hO{9dw\$u更ƻ4F ua 5`F:+ED|bLeBZ:z x`=eXi AGfsBUk ]`\͢ᢵXraqqޫ?Z /j)U-3F>`G>I5ZN+q| Y.Ii|3ʔ)=j㷄?uxtތ5>+@wu*sy&HHB̝?dvZ{Vtwoց{1Ø-Wȃ^m=mT Vx>3lo< Ӈ\]'%q?x%S ~K/SNICu ׫ J&hC4+&@lM^F?~ )\{l"֋mM ykTW6 p|̌muFj* =j~nٮ;)X1eVVe^QYk '!}$0CQyHKٓUk-VGPjZ`@Od6#.Zj GLG~[i5zTNN 5u\4ڴkF/Onlݸ3wz6Z}dr ] ՟^WK?&k(GC͞"՚1eVԉ"Frf/txS'bܼJh|Q𓯍XuTz`GډgV/D6__wr6_0Ģ^h#zi:^iٲ-G&o`z"ɐDi4BĪHa|rC[cKV6D`jn8 sSu)Pe(fyVRTщ;bUk)].9msKz('%8EI-f/^t'ZAuC ,8~ۣ8<(ƛ_(hKYFXg`AyPdqdIi(\e֎j8s^9ō/}J8S3N4H-rS! َbE{lg![bL+aA2Ƣ}% А|WCSuM(]6lcKo\Vݙ<ħǰTٌG30T*O[!Ŕ6{Gcju\=ҷРJtQeUPL5c~VFr5~<4K\08dC;R`ME?r]z;P+PX {PGCr}#jKֻ q܅']L-R%0;/xcFTpJmDOĨc9tc&F86'9!ypADr43#{7 }s&*H hY)זWнRs!z7lwIU:LJYj,\!}0,OO}2K`9 ˩؜5~ /;#dLuϞ湙gjSGWZ>GVU)t _Er|laY#=6@vȕŽo xOղ4]&!4kY.qus&owng> %('陈>nmQ兗 bM^ęs:t#^&"ֲ3֙" \OILތ8!kEuFl]ѩ C-Ħ(Q4¡:AŲSL b- CשƖmO N&0&i9vUY\NߕߓJfj<=}+,^шMU|Jj F4l=7kkL$mV7cb`vij齁/oEHm9/Ǿgۛx j΂" I.K3O>*<^7oiᷓj:$T~IYD ^e~:;tLXqS:6@ \$1\{`a1zz N I]w5B|RIaJq4TC-vt4HpX.Z" V}K!^P0$6B6!;ED mi klE endstream endobj 98 0 obj << /Length1 1908 /Length2 14793 /Length3 0 /Length 15975 /Filter /FlateDecode >> stream xڍP n%;03{pO{pw zr}UT1ӫׯ۽$UVc17JہYXxb 2,v&6JJuK ?vJM<ĜFwQ b`er~eaމ nji P`(<,-@@cB `g8@dibdP0Ymw41ٛXArefvssc2ufw2eY,@g+GE#[ߥ1!P-,ZP79K{) ;@MFY/߇`eboHdig9PgFv88ۿY;) )0zM,@LΖ6Gc3ځ'n4y?w_2L]5,]2ANn6nt7`cukrw4!x9 '׿XY& 1f_,YۏOzfjogYEGFDC(*jbd0qXY8|7:+cgfK9G=@7{44. 'g.#k_E.66ndki{纀ާ@}UZU4ؙw4#+ _vKgIKw%⯮ˮǼX-aޣXXX"}w_ ;{? `d߉>@?dgz0wBrqE0E\f,%KY̒+Yb0KC9f}{?`V8%,F{]=FSf6k E U Y O_._|Mf}~hCb/?:̎w)Nw) ߅ ߅l!'86F<|V}?km?zSk$@yj#$Wy2#HǯEx a>-a/|O372A+Sf3/;D#azo_<Y}8Az,>g"1Z߄!D,KWنPZgMZkZ2(T,%xC862v|qC߼6m򝼯<7{c EfL3;~R3H'ſvrfH1JRF2)t*+ ~JqaaPiiE9G(C.U[hj0|UHœEyŏ'Ur=/E~?Z; T򆯢Ey%˙rx&}XŲ_<ŭv}vQX i%Yfd>= 7SiRlE"gxpt ה/Yp y"'q1$WӦzW?Fn~>Sn$MhaqlPMiUJ=Aw@_gBk@O+W#R%Ylj;KP}#8m‚<;0V}b""%/Nl1ۢž`cs5>% ERbIo޽<'~!k'"@i^ECqާ"s¨4 C^sB#XAfpq tm@XY\5lo-y` \\1BjhNl7`!1Wz;]qBk6Nvj !irnEcV.9Ƞ9>\t6Y-/6gFz$0cMg+h^K#>c=LYQ0=c Nߛ:w}aO''#yZ+H(*\yt. uUps>;j|o Ittd+Z;’V%1Qk:҅CnXF)~W@h6|3G <A>3o0T+3,JZUa5% .3zG F11roeC؏VcNxZ'3kΙnUíпB`W>hS\8dbZ5zz /o P5楨A?-4) O\^M1Vþ G.QO\d;brX:RS2 C=ĨD-,_sԗMYi=&0j`n5n1B;(6kP6)} Җ#tQ'ɆG; )*߃UEi}\n3ܴZ G"Gy6˘znW2oD(J24V-r2+EYKf[58`)nRTlڱ7w38B/f@zC9=q@Mcbf[ipVǗRe65#_C_FFkn9~"CǎJ)pMF*Xl0r=E{t z}{ibF3n@3"i9Yrgrиk%sšRMhԓXfxxCVɐO=sR]\5hMPv**Ovvmerj4O-+qUn \5k8u?l1R(2;a=%06&NKcs\/53CW F6"C;ĒG]gv>@+ӧM2)*Hnp%9 DXra-ƼٟڬWȱ֭5.3f'{Cgdg44JJV|솪P-2g@kƎsX ~F#2aMUGhk\lnLtsC;2Xer"sDoz+_pu299^ Hm7R7χ@3yo~oM{ } ƒƣU]ӏgfrmέ9l}E G~{"v~KMTo1Ck9+1 A!|nwųYU%m38Ǟ;85ρi9C ܯ?Q&"71әApZoZ/S.Dt}x<ϊCuT>ˍtpC˜ gGpHD"VWV hV6/m*=*쩃1otu" n|64Z^MGR`6|=88k^ cX1фyKSQ!m/l;\Vq̧> zP=Zo.eaZҶW~0vBT`L9ЙȠ9s>֪9YxYž=UT?a.^Vr& P;{=PjEqw iKnUJ鵡>Q? '~|A|`Yب 4JP? ͅv\e#i_}ۿ}+6qB÷ƠZzbUE?WL zޞ`o9tk1?ױaXNP\W|KŜBp -P^4Sx[Ml) [ȩ2ӷ ea;"y1Ba>wŴ ܣ 9m#6GHM" cXfMh6`kr(=ݕ>"F49- 挩xĿt"-=3 1wd^9"Zck _NGLĤ݌75ﻲF.V ]._5TcrB/S۟ :'2w?mQmߺi|љ4%t#CL%K _{͂Z ^ j%G3T(oW|GYu9ݾ#7/\gVGDQ3B52e J!HJEwNfg!yC_لSNU~|:i~: 8rj1RRu1$Qjb e>T~ ߘH'zdEyjl@nVQ2v NjOh#cm @gH_ ʝOΕveͤ*6& ) ?bK x P,WD30&r2Wy8bÎ̶ܑřVhzd:+j fkQl|!9T sw*$qW8DΗ@=Πv izĕb msCdt:C̓* 넞W`3 C#ł[3/h$ėzV @J%KOO΃S}7}]$ R!f#LF҈.nwH,YQnLN%2-zA'kpG6 D 5%Ї E vԤgo9>9%-t_񙘭t ~C=xkY.amj<)L?tAcˊb$GΉS; x5_ &*u0Et,JI9hgfd|ePu"T~LKK|5+q#46|{&Jt>k_iw#=ĝ7'pj'YݮǶRD14votߥ $x*bb2KeZn ޷w@c 9 >=)}n}|#RH)$^w9oآeX }pP!*Ƅt(r8\v4 7㹸R.2.؄m)Wz2Pf$轲fc@~G?rjF~?k-'z@^ uMc ?͗"1 G$wd]*&mieZ/4Mf^g#c H^׫0X`l/s9i$ fLXŸI^]3! L/Civ&EDS6$8|>CN,-ʰmmV*/'5QMBϵLJ ع ~dVF ovWߖh`@XRq EވЧnV/LO #)/EEhdS؀]-)]*XxFDAʼn_/]&ˬJPFvZZCbMɌYПגd7~mXL(5oGV%TD*#os 45J6#Gr1d D2~ |?H N.ZGUy"륉Z: 5칵]%쇋BWkaX܍E֨'58Y_"Qc.-q3 ME0*htFѯpg)Cq ^WMmQH;2dȁ9>SX ĝmjo#OiÄv;≫ /i[oe-ㆌ7J"'K#1 6(;EUg£#0r㖿Xʻ,2P.t0{ymfqQ0a~$J)&bb\UOe穰(2W6R<>= f_BNB$j;GZ|{ٟ\NE@-{c& YEyz*OtwH@q7c0WoT%˸gӛ7 KNҽ? M=܍NϯD[GѲeXU|s|ݾO|eAٳ?2%VT'$+zFUVDSfǓ*8Qf4!vH9\ܙ",EQ>f,B% QE:'}e  ڗi]$(7Jsg=^Q=kx|d''PuY^xm'hI5{Ul@3?9c/pALT1F.Z9km:3euq6Ҁ)]zJH$^!MS+Ih-$|Sf#Xr%rI~7H(r랼^>XG:(Vx>~\76&=iK89'xjwk6o~9nl4)6T+7,`Ӹ`G5sf} nV/qcޏyu%o!sL٣ *];mNΑf%M$1~\[iCSxd oJ%y?ʕ۽dwPN0 B5{&s- vy@QwkR 7Ώ !ȡPKm9,b3yp/\7w+P:=HKUAS )GnWYWII366ksjJ!z-¬Sl Qc Dץ-[v8s x\Ri48AgXRx4%ȗWL6W8 ֧)GYvV>eGmXbq)68'u,LW"Wvx 2Q2gGZ$:s`chb!Wf2=gߧ-Xln]ܫ.i\[b21 KDݸIOU4(moC(Dq{ND˩Zq]٢"Mj4>@U^p4*9{PΌaU@/{<[i%$,МB *6x{BrB~֜.(u a[#JiV6l<_\/ nNנ,5~ AeR!{Ą%V먱[DddMul=0fa %M#]tA8NظJd .lr\ܡ3СݧS oڒ}܍Jo6QZ)5;^WNs,T˯[g`Z(㥏y,h/ȌbP`H5F!Yw;8U؜?5"0u, cKn-Փ,𩍰%+M-WN ?q$KQyt= ~H$u! kdHZH"o ͮ(fCUUoSdZDٴAl{񤣢j[4_ zc+/2@-G!,sT!_)Stt9CBVCu+xWx;tQgQQyȣwLt6%G'n= );׎d;p9*eH&?nY֪T9ތk=霂 '˛m s>aΆ!Gq Z<h ؃ʥo!W(CaRG5ݕcboBآGܜ3^_t5K`DɎy|7JzWjtT'?Z!^bԒglƻ;]Y峏9\1x6>Sfe~״en>[L<ڧ'^^ۆM|ODcVS?]>9`A[Y<'B9T8"fmPCRy,6Nh0}âo jDVg/DŽ;TRӲ E𿨞m$htKn/+I,ɮy`k|rY5J)D/Hb E¬XW^TW|23Tc9*ncCf͓|`/"=> [c`RYNQ-+Z9J3l'>6nA.CCS}+QFHO7kld`ˍ(b޽AD35rJpOtpq: FP)_gBo9 fm '&~Ut+#~JqkP8FGI,TёD1$Z_gLu}eOoA?GޯqUAR5PfaE% IsPi^c]ч䷠fڵ, %ɥfzR%/wc;=(GmRB qO@'Ph EZ}V8/A+?`sLk。9ܝ:LPwW;$eɈ(gqMDv62^pja/ ͮ}G[0%˜5T {!3T4޺n|ۥHҜG#q 7-IEҮTA}5&ܜZM]?*"kb7p a=$N{ *QJslL8eQ^զ0ij`fO D"MH]S;RMGab)l46Dqg H[c!KٶXx}ՃX9#7Oty[qL$bie2%wc%"3-X6 q,^S-̷ܐtK b'wu .W7#9c#Q;fD)QJ5ݟ[:X{3߁j/d ѯVd~|K/i?j8\o'eRW  ~nVvpmXB%?ɚ`%02 -oVJhgrp{` rǝP{K{uLzsH06?TUGw|,U e!18\Njm=bnҧqFO33=лrI+5z\JDoM4^Heҩ\v@k>s3:l`&lvnZÁt[*ȏddoQ_UKԟ!Zw?J_xz[S^Дy}ğg Ds|],Ax= yl>WcldiD:FH / ˣ2yT>h ׻bS,W}} • "K z޲ k&GX-^b(^"Bu".]vGEi|RxUjһQ&ZVNj]I4ھ 4iH}]0+d$dT$~5SI.>xXd~֊`WC;FTɴf(f f[z#L2` y,D(嫠RqQlHMt>^Aul9)C?xX\Z7UL&^BRSȜʧ)N/I{ٚ[{*r@ -b{-TEZd,T^kchb3J@n%$Gv$S#6y6G}ߎ͔'!N9hh PYΆ g>#*ecc3G+>u>>=ԀY*lRSJ)0p/p^vgD, +G]h PRǡUNɂoAs&^Yiw5ƚ4W҉;@|hưv:ESih/"sǥ:\xIɔQE/μA;_cH*PF[ zM.Dӷ:'<(@h65m}.l$s`,(_L#[[pPq'r>51ɪ[c>^uo#ױ8%G*V~[i󇒦5&tQs3(aԧ[vQhPwVdEWP֞ ([*0LsXѠϕ@bZ: ɝ3A_tbtG1@uWl}]fv, QWu/a4](&1K.K}P$52]J~8Λc'14Lo=ck_Q#ؔ ?"coD4@ ߝ˹7p]J!Iж HT;7 2H [p BF~-%X(V|b0oE6?_r c0ko)9^7ܮ ~!e;7DЁ 2d9~.Ϩ͋y+1$|SDLdn@7Gϡd'ݣVlDz-ʂħ_pDZ-*E ABI+ 1=שO/dumv\3S h*eK\6)MYMg:wBsqOUca6+Mޗz=1QOd#{Ùaʹ=B[<ESO} 9B.4w9i&(i 8i|aê]w֕JUf^)^c1!fV`^Fi睊e-e:*^A 5&^'c\~{8iNDK|"__ip\s-{햙Xb#z rj[s[ckDܠ(;;+ cQ )4kZ~f}5ج kǔm{J|qn:z!N KLSiR`g;R8':0k8aXޡ1ߋWhlCz |_p\ c^M GbgX.IpA8IHU#[Agu&M2񧚳)ºhȄn% ?!VS`T|l\ \CO|J& &ߤP"r&ݮa]^SMrK)%zP<,֎so~)S$֗P\op9 4 ŧ{mK(WٯUHbRN6"I~]z1*v>D^6f}563+51)~s jl!-TL@1wv%m $;@ӛMG;`>K6|KƯo RH()oKW8ѮE(4.k8VTRWX%6-wTlbTշ\l[- $Q%)sV4q\Xba .H2&ga8s 4U8meFxA8ձ Pq;/j0Uaw. ۦ(y"t:} 9mx?tq4 ,_\0E.y<%ml\aLt-q"DK~Kcg .^P~Ю3C\glBR;*zSYذqwxnDKhǰb)Zio=WNHk!SY?.A?1BM +g+ +^\;tZg+ MUX@(M]|H_%h(3?btKh&Q *sQe-y)+]1Ը U<]cʣb-&}BF13΁@=rBŷYVe <I^9'l3vF endstream endobj 100 0 obj << /Length1 1969 /Length2 13327 /Length3 0 /Length 14529 /Filter /FlateDecode >> stream xڍp% GI:m۶Nl۶Qc۶a×;wfޫT%緼^k  1P΅ "`ddgdd%#StWKtrC&ja(gov0ع8̌\5wYv@gX2{O'Ks <40qqq:Y\,Ml*&@ AkNodLodOE pt(Nn@S-lFKPtB X?\\LN)Y?Ʋ1u8&zG K?LLm<-f6@, -C#g#7#K#?K7 )>:?g'KgzgK?zd#1ٙ\aO hq ]6L],]R|`]l,#abGUOJ?=z;;>Z?z;.N@_+`&.c??@;Yzt?Ə ߟ>&?AMHU^M毖V {Xt,,6;;(YUſ<\)[_@zP7.#/#ߊ]mlSGodkiܺ|쀜&_S WhjjR.F dgnAZ:[zM-]L,3K;/ >p?Uߌbv&,3;cLh s v..|fN\);A qD!N?`8  A }d>2C&Ώ(*Їg}C;X?t3,3+>Z1>|%HlmIE1 ?RGbG8X ?:~Tc/(rG2F.@Sd: ?q~˿6GmnA*1Uq5z7I Ng/ww&Ob)6c"+smJ0(dr:ςkՂsgSr}Ϧ(iNZO kGߡGIi1j%bM}ә&Ϗg=Z|G m`m!SC)26~S#/`)S֠92_|Wg ^gI>qњ@ rQclrԦE.PE߾݉[=sFwKVӱDMv'cr-ZgNh fތ>y_xNj-|ffK 6jemsl57F [ ^mq7.+4.f$Ia}TZ{VPDH ӬOzE?Ҽ[v 6ᰖ ,YS|)pPee4\Xdr9CpHܩ2}lDp_vq$wԄ0DP9l"E[Q|qI&D؆,yn丵{}'z"D k^> P&sPjPЂ I9%M.bjY@ Z/=$G#vTfxɏ2oHHZ5OiD'C$;@#(O-w"(Ȯ-@wKvt/Ih1A /&Ȩ}|TaUnWOtiĻ΃S@D{Ƹ5- ; ߏ b( -!UU*$#6? Qn Q737[|ZLmj=s g OTa C(eE,d {<$v^X= #De 斘ڰQOo8ҦIk8v`%n>A9N-ɥu?/2CٟQvw#'`.}d@(.pg (M8>79 WK(Wz@5_V!~[ gkYp6U%M&Z'Q{l(+ @[5\02UP!Mɏ*`/tb7*#)C5(*z)| BjF|Njy5!am.f+6'F_m+o+P[C]qɣ)x>!^ -9Gڤ!?@2W䦋8c⇵'#@y9kd6QԩPwYC2U^D|Y[ߝFk;Դ߹$w\YV qv=vUB}r̸+z5]G=$^5xC3i{a Z[4yCqAЂTw|F5@zIyCj =ܮUi6s)&Xcs ǻ:|Y+$ *+J\Bi BoI.BAOpA`vFmA@}%ǐ@4KȓFNJeNA!,8'1͂Ӓ#\[x5AHI1Z|5x-w9_IY뀠 2}ZUW#6k_&ƉR=)F䞚8M*8gϿƥ x:Pƚ0A{R_RۥiSHF$ L,sInn\K @0GlxiNC3 poc젴#c|& k{H5Rxe@B}[TOgVtO!g !nw^E 0C0&NkNRg'8m(ЁL*'*nAH/B ?Ea^=*͊KUZ{\e[J&BSr^V̂98cW{yЮz'M9eW5nVH&,Rxfw8{G:!x6WR|~SG#>?:bf{4wd<IM' Q{z^=3FB4`l[|҄7OUɒZ;-vh3/utHOй.}_R\1 K=R9Gvt ]7u0"JnɎX"_B9u䥉Nޢgn2_ū+>t+XwVo4Biqgӣ3~mCK_k_Ods62B~e@k@#6.TCĿn33isj쪁5LOdӪ Tٿ;5( 0b[tz[>amVp=0ZtKj:/@Aj'{;A˓i  k Czkn1dyQKE.7N۩qӷykEch@XƂ)/=*hryoAg G Egb} #/r0j9g+9ۖZ[m=-X["/~x^j"aZ_D'l]M?*ѫ7i,eD6^C6*`6\ ""هIi`hhS9<0Uz0fxS^EFHM"; Iyk%/)c-bqN79OYB>s; Njb,\0 P&L@^Xθ?/#a!~|=oii$Jx)VɋL <wxg(/?I…9  `Lil*TI -k ܜ0 àA -2=: j·՘nE.Е+?;jIAʸTV$R}PO.J@>5pVHRβWeT"$^ϗχĘ~&{՘X[4Hr(թu9yQiwyz_ʡ[ zI{cPLńOݹbM3-ka6: kGFdP/GҧJ%.nqdcw`&Dw袯4ZXK9rS@(c:"("b #{/1]1i-lʦ bSTi Lxu!faP*uq ;09e-LcE*Cs9k6mA y %^VN"h+3̭8Z3V "  Kw-K\&`(t|xD@5B4Zi:E@@0#" K k -J8yofFz{d*G.{RdpҍeB[ nXc} P*(ʐ@U쥖u,TGcu ά𫿾ՔRs#EAшqFΗ_${`h6?Mco./H-iq JYċW쟋1:|gʿ[+>QJsX1'5q$( c6 p,%cz?=MtD5ߓع~)ƺ3MC_hj|RJr_tB;42g2R7au sk6 n :mtפ&vS IqKsxlR@O# ׍=F\;"" jm(SƆExv}::_ at}XR"LmaBQ[C ?q)%p2P; ,ضQD_)e@iQHRA4<妍ܲۊ~.IBU#5wJb')z6Kbge[Q"MyqHO  lܪ=o{͹䙳1ƕVs y%qV45sMKkUՖ-yƤž,G2UU}@K`ĩfw3@X+.,R-}7~͝mv8|9qE1D:K gEd>Ω]†~sw~XP >$܆  5$~?y9bs+#?"N&hWzb5*A'>%TV#b"2_5Lƛ;BzisȰHB:~@m{ hWʶwό_W%K0:ҹJvabZy`/zJ%wߎM4zؗ3RЅ+&uCK{v>QZ6r gPןb{]{"w9g}Y~2i=q ЈCh`zb )Nm&S4:l4(/?4r.^:p?8;qg.7֤Ib!9nya #w[XvP#&68S$jAƘ8{:QE<)9VseBq2W,cI x*t gT#c*`ZZi~ݳC%ݫU6*9޻S( {Ysf>u+~ /?ް^bPl@𿡮nF;W7KpF^ڸ qp@;x]R{¾QU-;cL @1[ #4 o%NE₹~ցP5-׋f\[9='%G$S I<Ӕl Y M9,n%A.rVL#ݳlZ&ΪG.qECyȲ8#9}g44'vDɦۼ46TohG z!uB$sjc"]wl%/}X=z( =93Қ4 Q&KT47 e/ql10PwDoD-_Em${4 lpR0ƍ7c#{YQp&B7cU!?rRtLY6ynJꪔM]WNh_ߨ [ݤ@}~ Ƕ&Ͽd+źAWܒ)DW8֥5Z!* CQ\a8DWiMIɡ xR/A عO{}ύ/wOv$J4EhQ~F)t8#pNǨPABb(P2+$gL2ڌCYSS/&=o1AO>a.^BX72pڤu;[H̴Ѽ"磑;wf^P}>Ynr١b_8=Zcx-k\"j/"5yy@rV+SL<^LL?k L)_bH#:@o,jPvʘE8 +/R`P-p*vz>>j;{}M8Flj#)80>KO椇Xm'젪A0iNE1aV&@(csgb++/X y%!|_LɈt7p龷N1Dz*m:*udkKE } Iɩ ZK^1xƼ!\2[ϐ=^oYm%gն3Z-/(L6+Eo.LoYЧn/}u>QYH8óa9Zɥ\5sԒ6BQLQ7u^7I7'-,|b.Ս^lݷrqĥͫK+C!kK,)o{U`u֠\nJ8![:Uf.Eo£* n5sdS9rp MJOΑ gZ/S#E4ZqϤV .SL2ue, m˿Ӯ ѫĶkxwjDOO[ RЖwU~2E'QiwJۄZ ԉ;NmP7#Q;* (ԝA dN'%r $pxaxG OoDDq]$uG>,-&fe'$pg>YoH2\.0B%2XIN?+x{Qo=Ļ#OC/ۈ]ө2нRdbvE9cds\ RBCtlAz0F19fsk?=b25".mHϭg(ğҥXō @6Flo2s"Ȩ/mI*>W;+e9ck\ ߯AH.vB(o+9't lo;Lw ~0*LEc6hQL={Kǖ֮9+ @EYS\!CS3lŊt-,;k+ň%_*&QFqI|ɚEct₩(|f2kΡI)ii¼*}\f4] =qAL9@;Og_0A RU]K+EnzZ ȈWJJ֟˚樗-_Fµ}E,6ȋA Z/맘ړ#!eEItB./+.{ X=VqNT5LdDƽ*4{-~l 뙃G*{gv 2qMwb@䭋Z={qZW&2N1Ζng'8?HMM\_Q!ʼn I'ÌD/[qw{|mɨ;C_od!{X_w:(q~Cۨ~o1 7&Ink.zN 4ŀV"1k b~wԁЯ=ZKugwj]UtJf };2L &&j<&\<K>iD0pQïu${ M.iG ˕t.a>7ñf߀aS8+\j%UgKݝ%BGi7J VJOƀXvP[ӮL%Z$M\r$AAٹ1cTX743"\uCK10P VwHG5*IgjR؉`2rv~r8*KBSw'Xu% CZ܂>kf BJ^"#Z$SL)L~j4 s#WD~[(-[$`d2QC{5-7h hvKG\&.rߝSˌp"ͲGٱ1G2|wu`h"9ls{@Ɂ3 ܉{>٨v9U9o~%_ͨnmt ѽQ'V,\qJ05 Fpj\I>oQȈnB֍K/*˲Z s[DK8D9،]NV7r~j [.^P3L%Ã8P~pnX< ?#rHiƟH/א A.LqB1>uʓȲvJO^ Հ_(<9W2~]4PtU+/22Ǚ!橱ocyVY.̰ǘ]MMm>{B 蚇|ߠVVڮ>Ҟ16K ^u?GV!pK)47ۙYN .za 긾7x<'ݙs35 fۣ#7 4%zN8NACU]=4طbK }MM*t|U!u7E%Z5qp)x|`#jv{%M\HW2,1l~DY3@2\vqEV*yc|]tF_^ʯ˸C(* )Z")3~ui釛F&H*޷£)|5mhՏsHX}EøsR}2wIˍ'&zL} *G \x⣢˪TgNJy"tjUU]/_K=vwEaWiNn} Lr!m+m=pߨ\M2 5LEs$dmy;CJnf fs3CQ|ED],5^L}rd%ɋ@hvVe! a[A+x:z]JoWPs3.}5i TCq*֠yjfdcqy%%R38g֕eDnۏRB'a+di~!n.c !Ƣ/y.!9~ W*y!:?`Z(+Zl4g=7A"~ #3/oտw\?|Ab@MO0L~x'͆bFW#UN _ekrʲ.gM`@L[Տ@ *ָHsbߑUҊ@;VvBس˜/B^L\g FY؃epH%6ni`}JĪƑ' ])ț=Z[z<^ՂZGH 55^_ fPUVsu|s/uuk W6E +s@tY?+}v|Oė1ΰ`Cg?W#l-Ǧ /AcgMU93ʛ\,8}ڑ6nϛdy\-9Lł=&>"^p?v=$7S_aH5U 1ʸ-yiEl:# &Ow.q7 VFk_tʓgP%OIIyiT RMC!PFP|T6QIn)Bwty(c܁X)5ؖs+h'> 0Qfb1 SCf͏2xbC1bZ绡'ƻcr%6U-Կ~F囼69G\+XWVYWMa71\ s+sɑ;gzU$L obIj"cu*7[lwp^ !X~ endstream endobj 109 0 obj << /Producer (pdfTeX-1.40.20) /Author()/Title()/Subject()/Creator(LaTeX with hyperref)/Keywords() /CreationDate (D:20211026173457-04'00') /ModDate (D:20211026173457-04'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.20 (TeX Live 2019/Debian) kpathsea version 6.3.1) >> endobj 2 0 obj << /Type /ObjStm /N 92 /First 707 /Length 2938 /Filter /FlateDecode >> stream xZYS~c[XUb $ YƱIߑڶmL2oSj,YZrK2,ӂ9f,+L Vh&y&z*S):J1 S76LCM3!hda`&Qzk WkgByupNBAa688}RDy񧕀;,P9@) Sd!A?h),@`H=0 $y %iʔt`xϴ.8* ``xZ 3 25NK),TXySPnp耭q1X@AYd8 Id!Ր.}qL NN3 @+pepxL@] 77lx!PbQc勎; SO?gOU r[ɋa5]ž*ݖf߲Ao:]Aq>e&ḬnGS6hZ-tdehLI{S'V=!Ϯoztݠo?@Aݲĵ5Ӓ)bnܛTd@:~uIS>׽F LDonrUNfĞ}csP0`&1ռ3?4\.nx7\+"z_Gh隖XTTdvhݤb궡RgHɺr3k[JzjC=]*6Wdmv> < ] XgqKi!ioK6.* ]T #3<+܀W3K.m8Kp8 Z:-qqO>V?ợu9%_ 2I\&W@JP*(z΂n=9=0lCæMh B`0je?".|]ٹ"芧PR׿?!\.VZŨ׬v]}Mp]#,9W!0tjZV.uh^HStq dҲXjtAY`  B  48Q2 QXD- 4G~2XvӑB@؏ј5v$E ؋87 Ђ-_jcDךgv9xCnic\Z5RlZsDSo!fhsȊ[p\Z"K&GXKHZ's$( rTrRZOitїϡ^G1^9.D+bյi698B!1gmKֱ:5-(U?=>Լ-ntQVԜ$YrT, ]=JujIX€XFE dV-:W.9aaCE>/έ)o[Z녡VAdV{#kgދ I(tAQ/9$MvFT!a&+ֻ0Q;1xwI1fncFEGQLO}`F#Eg[&"J "Se hҥB4C+:\yha_N&q5I F8=9y?{ǻRл2vc)b`c h?-PN7~^oneۖ4 W;ÛA*:}= moB'|}bKrď O?xWjK_⟰e7~ߖC%1m*&$It'|+^NʒWͿm%9|#,8>%,ߟX*j8X3s[~-ϘOfMz޳su(=~#Fy٤en[°g@LJ/=}Of9FBO?yyrZByQ'ռFͪ`4jU7E}Nl<ݨ*ƿ>(6*k>XC_ ,kXQ5{CXsztvHSPio~AR6 ǹAJV=MP=!яq;#<>*M.WX^]UlT.Yvs-/i37sSgiufJ榫7*;g'o oR[SqY-SPwb˥u YZurλin/@'A2GA*<_WSʾeKn/|.u&^o.l m64gͅh-پ-ۻL6=Ԣ#`_ZQm.w얛 o~xM-de7-KfLͬ~D-[җMr!^m.Bl _6)pO3%kI_ 7tzA4M_>0ez:?hP:uOAH,,i0c>+xOt+otX(=Oʿj+M1U|fXLVRpIzY9/I_:~ %Q+ͅ"EILw{/qDE: <9E542EB96DE2C18D45D079E247A42623>] /Length 266 /Filter /FlateDecode >> stream x%MQE?d0M4`rMl\W $`  w@,3|:H433 S  P PgPP!C91D!Pq8jZhYP [;p-$lBtA,6؆ nYɧ0C0 #0 q$LY_0%eO>fe_^sGy)?AJx-Je%%,^+pik[SzO! endstream endobj startxref 137145 %%EOF graph/inst/doc/MultiGraphClass.Rnw0000644000175000017500000004436514136046755017010 0ustar nileshnilesh%\VignetteIndexEntry{graphBAM and MultiGraph classes} %\VignetteDepends{graph} %\VignetteKeywords{Graph} %\VignettePackage{graph} \documentclass{article} \usepackage{hyperref} \textwidth=6.2in \textheight=8.5in \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Rmethod}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \newcommand{\Rclass}[1]{{\textit{#1}}} \newcommand{\Rcode}[1]{{\texttt{#1}}} \newcommand{\classdef}[1]{% {\em #1} } \begin{document} \title{graphBAM and MultiGraph classes.} \author{N. Gopalakrishnan} \maketitle \section{graphBAM class} \subsection{Introduction} The \Rclass{graphBAM} class has been created as a more efficient replacement for the \Rclass{graphAM} class in the \Rpackage{graph} package. The adjacency matrix in the \Rclass{graphBAM} class is represented as a bit array using a \Rcode{raw} vector. This significantly reduces the memory occupied by graphs having a large number of nodes. The bit vector representation also provides advantages in terms of performing operations such as intersection or union of graphs. We first load the \Rpackage{graph} package which provides the class definition and methods for the \Rclass{graphBAM} class. <>= library(graph) @ One of the arguments \Rcode{df} to the \Rclass{graphBAM} constructor is a \Robject{data.frame} containing three columns: "from","to" and "weight", each row in the \Robject{data.frame} representing an edge in the graph. The \Rcode{from} and \Rcode{to} columns can be character vectors or factors, while the \Rcode{weight} column must be a numeric vector. The argument \Rcode{nodes} are calculated from the unique names in the \Rcode{from} and \Rcode{to} columns of the \Robject{data.frame}. The argument \Rcode{edgeMode} should be a character vector, either "directed" or "undirected" indicating whether the graph represented should be directed or undirected respectively. \subsection{ A simple graph represented using graphBAM class} We proceed to represent a simple graph using the \Rclass{graphBAM} class. Our example is a directed graph representing airlines flying between different cities. In this example, cities represent the nodes of the graph and each edge represents a flight from an originating city (\Rcode{from}) to the destination city (\Rcode{to}). The weight represents the fare for flying between the \Rcode{from} and \Rcode{to} cities. <>= df <- data.frame(from = c("SEA", "SFO", "SEA", "LAX", "SEA"), to = c("SFO", "LAX", "LAX", "SEA", "DEN"), weight = c( 90, 96, 124, 115, 259), stringsAsFactors = TRUE) g <- graphBAM(df, edgemode = "directed") g @ The cities (nodes) included in our \Rclass{graph} object as well as the stored fares(\Rcode{weight}) can be obtained using the \Rmethod{nodes} and \Rmethod{edgeWeights} methods respectively. <>= nodes(g) edgeWeights(g, index = c("SEA", "LAX")) @ Additional nodes or edges can be added to our graph using the \Rmethod{addNode} and \Rmethod{addEdge} methods. For our example, we first add a new city "IAH" to our graph. We then add a flight connection between "DEN" and "IAH" having a fare of \$120. <>= g <- addNode("IAH", g) g <- addEdge(from = "DEN", to = "IAH", graph = g, weight = 120) g @ Similarly edges and nodes can be removed from the graph using the \Rmethod{removeNode} and \Rmethod{removeEdge} methods respectively. We proceed to remove the flight connection from "DEN" to "IAH" and subsequently the node "IAH". <>= g <- removeEdge(from ="DEN", to = "IAH", g) g <- removeNode(node = "IAH", g) g @ We can create a subgraph with only the cities "DEN", "LAX" and "SEA" using the \Rmethod{subGraph} method. <>= g <- subGraph(snodes = c("DEN","LAX", "SEA"), g) g @ We can extract the \Rcode{from}-\Rcode{to} relationships for our graph using the \Rmethod{extractFromTo} method. <>= extractFromTo(g) @ \subsection{Mice gene interaction data for brain tissue (SAGE data)} The C57BL/6J and C3H/HeJ mouse strains exhibit different cardiovascular and metabolic phenotypes on the hyperlipidemic apolipoprotein E (Apoe) null background. The interaction data for the genes from adipose, brain, liver and muscle tissue samples from male and female mice were studied. This interaction data for the various genes is included in the \Rpackage{graph} package as a list of \Robject{data.frame}s containing information for \Rcode{from-gene}, \Rcode{to-gene} and the strength of interaction \Rcode{weight} for each of the tissues studied. We proceed to load the data for male and female mice. <>= data("esetsFemale") data("esetsMale") @ We are interested in studying the interaction data for the genes in the brain tissue for male and female mice and hence proceed to represent this data as directed graphs using \Rclass{graphBAM} objects for male and female mice. <>= dfMale <- esetsMale[["brain"]] dfFemale <- esetsFemale[["brain"]] head(dfMale) @ <>= male <- graphBAM(dfMale, edgemode = "directed") female <- graphBAM(dfFemale, edgemode = "directed") @ We are interested in pathways that are common to both male and female graphs for the brain tissue and hence proceed to perform a graph intersection operation using the \Rmethod{graphIntersect} method. Since edges can have different values of the weight attribute, we would like the result to have the sum of the weight attribute in the male and female graphs. We pass in \Rcode{sum} as the function for handling weights to the \Rcode{edgeFun} argument. The \Rcode{edgeFun} argument should be passed a list of named functions corresponding to the edge attributes to be handled during the intersection process. <>= intrsct <- graphIntersect(male, female, edgeFun=list(weight = sum)) intrsct @ If node attributes were present in the \Robject{graphBAM} objects, a list of named function could be passed as input to the \Rcode{graphIntersect} method for handling them during the intersection process. We proceed to remove edges from the \Robject{graphBAM} result we just calculated with a weight attribute less than a numeric value of 0.8 using the \Rmethod{removeEdgesByWeight} method. <>= resWt <- removeEdgesByWeight(intrsct, lessThan = 1.5) @ Once we have narrowed down to the edges that we are interested in, we would like to change the color attribute for these edges in our original \Robject{graphBAM} objects for the male and female graphs to "red". Before an attribute can be added, we have to set its default value using the \Rfunction{edgedataDefaults} method. For our example, we set the default value for the color attribute to white. We first obtain the from - to relationship for the \Rcode{resWt} graph using the \Rmethod{extractFromTo} method and then make use of the \Rmethod{edgeData} method to update the "color" edge attribute. <>= ftSub <- extractFromTo(resWt) edgeDataDefaults(male, attr = "color") <- "white" edgeDataDefaults(female, attr = "color") <- "white" edgeData(male, from = as.character(ftSub[,"from"]), to = as.character(ftSub[,"to"]), attr = "color") <- "red" edgeData(female, from = as.character(ftSub[,"from"]), to = as.character(ftSub[,"to"]), attr = "color") <- "red" @ \section{MultiGraphs} \subsection{Introduction} The \Rclass{MultiGraph} class can be used to represent graphs that share a single node set and have have one or more edge sets, each edge set representing a different type of interaction between the nodes. An \Robject{edgeSet} object can be described as representing the relationship between a set of from-nodes and to-nodes which can either be directed or undirected. A numeric value (weight) indicates the strength of interaction between the connected edges. Self loops are permitted in the \Rclass{MultiGraph} class representation (i.e. the from-node is the same as the to-node). The \Rclass{MultiGraph} class supports the handling of arbitrary node and edge attributes. These attributes are stored separately from the edge weights to facilitate efficient edge weight computation. We shall load the \Rpackage{graph} and \Rpackage{RBGL} packages that we will be using. We will then create a \Rclass{MultiGraph} object and then spend some time examining some of the different functions that can be applied to \Rclass{MultiGraph} objects. <>= library(graph) library(RBGL) @ \subsection{ A simple MultiGraph example} We proceed to construct a \Rclass{MultiGraph} object with directed \Robject{edgeSets} to represent the flight connections of airlines Alaska, Delta, United and American that fly between the cities Baltimore, Denver, Houston, Los Angeles, Seattle and San Francisco. For our example, the cities represent the nodes of the \Rclass{MultiGraph} and we have one \Robject{edgeSet} each for the airlines. Each \Robject{edgeSet} represents the flight connections from an originating city(\Rcode{from}) to the destination city(\Rcode{to}). The weight represents the fare for flying between the \Rcode{from} and \Rcode{to} cities. For each airline, we proceed to create a \Rclass{data.frame} containing the originating city, the destination city and the fare. <>= ft1 <- data.frame( from = c("SEA", "SFO", "SEA", "LAX", "SEA"), to = c("SFO", "LAX", "LAX", "SEA", "DEN"), weight = c( 90, 96, 124, 115, 259), stringsAsFactors = TRUE) ft2 <- data.frame( from = c("SEA", "SFO", "SEA", "LAX", "SEA", "DEN", "SEA", "IAH", "DEN"), to = c("SFO", "LAX", "LAX", "SEA", "DEN", "IAH", "IAH", "DEN", "BWI"), weight= c(169, 65, 110, 110, 269, 256, 304, 256, 271), stringsAsFactors = TRUE) ft3 <- data.frame( from = c("SEA", "SFO", "SEA", "LAX", "SEA", "DEN", "SEA", "IAH", "DEN", "BWI"), to = c("SFO", "LAX", "LAX", "SEA", "DEN", "IAH", "IAH", "DEN", "BWI", "SFO"), weight = c(237, 65, 156, 139, 281, 161, 282, 265, 298, 244), stringsAsFactors = TRUE) ft4 <- data.frame( from = c("SEA", "SFO", "SEA", "SEA", "DEN", "SEA", "BWI"), to = c("SFO", "LAX", "LAX", "DEN", "IAH", "IAH", "SFO"), weight = c(237, 60, 125, 259, 265, 349, 191), stringsAsFactors = TRUE) @ These data frames are then passed to \Rclass{MultiGraph} class constructor as a named \Robject{list}, each member of the list being a \Robject{data.frame} for an airline. A logical vector passed to the \Rcode{directed} argument of the \Rclass{MultiGraph} constructor indicates whether the \Robject{MultiGraph} to be created should have directed or undirected edge sets. <>= esets <- list(Alaska = ft1, United = ft2, Delta = ft3, American = ft4) mg <- MultiGraph(esets, directed = TRUE) mg @ The nodes (cities) of the \Rclass{MultiGraph} object can be obtained by using the \Rmethod{nodes} method. <>= nodes(mg) @ To find the fares for all the flights that originate from SEA for the Delta airline, we can use the \Rmethod{mgEdgeData} method. <>= mgEdgeData(mg, "Delta", from = "SEA", attr = "weight") @ We proceed to add some node attributes to the \Robject{MultiGraph} using the \Rfunction{nodeData} method. Before node attributes can be added, we have to set a default value for each node attribute using the \Rfunction{nodeDataDefuault} method. For our example, we would like to set a default value of square for the node attribute shape. We would like to set the node attribute "shape" for Seattle to the value \Rcode{"triangle"} and that for the cities that connect with Seattle to the value \Rcode{"circle"}. <>= nodeDataDefaults(mg, attr="shape") <- "square" nodeData(mg, n = c("SEA", "DEN", "IAH", "LAX", "SFO"), attr = "shape") <- c("triangle", "circle", "circle", "circle", "circle") @ The node attribute shape for cities we have not specifically assigned a value (such as BWI) gets assigned the default value of "square". <>= nodeData(mg, attr = "shape") @ We then update the edge attribute \Rcode{color} for the Delta airline flights that connect with Seattle to "green". For the remaining Delta flights that connect to other destination in the MultiGraph, we would like to assign a default color of "red". Before edge attributes can be added to the MultiGraph, their default values must be set using the \Rfunction{mgEdgeDataDefaults} method. Subsequently, the \Rfunction{megEdgeData<-} method can be used to update specific edge attributes. <>= mgEdgeDataDefaults(mg, "Delta", attr = "color") <- "red" mgEdgeData(mg, "Delta", from = c("SEA", "SEA", "SEA", "SEA"), to = c("DEN", "IAH", "LAX", "SFO"), attr = "color") <- "green" @ <>= mgEdgeData(mg, "Delta", attr = "color") @ We are only interested in studying the fares for the airlines Alaska, United and Delta and hence would like to create a smaller \Rclass{MultiGraph} object containing edge sets for only these airlines. This can be achieved using the \Rmethod{subsetEdgeSets} method. <>= g <- subsetEdgeSets(mg, edgeSets = c("Alaska", "United", "Delta")) @ We proceed to find out the lowest fares for Alaska, United and Delta along the routes common to them. To do this, we make use of the \Rmethod{edgeSetIntersect0} method which computes the intersection of all the edgesets in a MultiGraph. While computing the intersection of edge sets, we are interesting in retaining the lowest fares in cases where different airlines flying along a route have different fares. To do this, we pass in a named list containing the \Rmethod{weight} function that calculates the minimum of the fares as the input to the \Rmethod{edgeSetIntersect0} method. (The user has the option of specifying any function for appropriate handling of edge attributes ). <>= edgeFun <- list( weight = min) gInt <- edgeSetIntersect0(g, edgeFun = edgeFun) gInt @ The edge set by the \Rmethod{edgeSetIntersect0} operation is named by concatenating the names of the edgeSets passed as input to the function. <>= mgEdgeData(gInt, "Alaska_United_Delta", attr= "weight") @ \subsection{MultiGraph representation of mice gene interaction data. (SAGE)} The C57BL/6J and C3H/HeJ mouse strains exhibit different cardiovascular and metabolic phenotypes on the hyperlipidemic apolipoprotein E (Apoe) null background. The interaction data for the genes from adipose, brain, liver and muscle tissue samples from male and female mice were studied. This interaction data for the various genes is included in the \Rpackage{graph} package as a list of \Robject{data.frame}s containing information for \Rcode{from-gene}, \Rcode{to-gene} and the strength of interaction \Rcode{weight} for each of the tissues studied. We proceed to load the data for male and female mice. <>= data("esetsFemale") data("esetsMale") names(esetsFemale) head(esetsFemale$brain) @ The \Robject{esetsFemale} and \Robject{esetsMale} objects are a named \Robject{list} of data frames corresponding to the data obtained from adipose, brain, liver and muscle tissues for the male and female mice that were studied. Each data frame has a from, to and a weight column corresponding to the from and to genes that were studied and weight representing the strength of interaction of the corresponding genes. We proceed to create \Rclass{MultiGraph} objects for the male and female data sets by making use of the \Rclass{MultiGraph} constructor, which directly accepts a named list of data frames as the input and returns a MultiGraph with edgeSets corresponding to the names of the data frames. <>= female <- MultiGraph(edgeSets = esetsFemale, directed = TRUE) male <- MultiGraph(edgeSets = esetsMale, directed = TRUE ) male female @ We then select a particular gene of interest in this network and proceed to identify its neighboring genes connected to this gene in terms of the maximum sum of weights along the path that connects the genes for the brain edge set. We are interested in the gene "10024416717" and the sum of the weights along the path that connects this genes to the other genes for the brain tissue. Since the algorithms in the \Rpackage{RBGL} package that we will use to find the edges that are connected to the gene "10024416717" do not work directly with \Rpackage{MultiGraph} objects, we proceed to create \Rcode{graphBAM} objects from the male and female edge sets for the brain tissue. \Rpackage{MultiGraph} objects can be converted to a named list of \Robject{graphBAM} objects using the \Rmethod{graphBAM} method. <>= maleBrain <- extractGraphBAM(male, "brain")[["brain"]] maleBrain femaleBrain <- extractGraphBAM(female, "brain")[["brain"]] @ We then identify the genes connected to gene "10024416717" as well as the sum of the weights along the path that connect the identified genes using the function \Rfunction{bellman.ford.sp} function from the \Rpackage{RBGL} package. <>= maleWt <- bellman.ford.sp(maleBrain, start = c("10024416717"))$distance maleWt <- maleWt[maleWt != Inf & maleWt != 0] maleWt femaleWt <- bellman.ford.sp(femaleBrain, start = c("10024416717"))$distance femaleWt <- femaleWt[femaleWt != Inf & femaleWt != 0] femaleWt @ For the subset of genes we identified, we proceed to add node attributes to our original \Robject{MultiGraph} objects for the male and female data. The node "10024416717" and all its connected nodes are assigned a color attribute "red" while the rest of the nodes are assigned a color color attribute of "gray". <>= nodeDataDefaults(male, attr = "color") <- "gray" nodeData(male , n = c("10024416717", names(maleWt)), attr = "color" ) <- c("red") nodeDataDefaults(female, attr = "color") <- "gray" nodeData(female , n = c("10024416717", names(femaleWt)), attr = "color" ) <- c("red") @ Our \Robject{MultiGraph} objects now contain the required node attributes for the subset of genes that we have narrowed our selection to. For the \Robject{MultiGraph} objects for male and female, we are also interested in the genes that are common to both \Robject{MultiGraph}s. This can be calculated using the \Rfunction{graphIntersect} method. <>= resInt <- graphIntersect(male, female) resInt @ The operations we have dealt with so far only deal with manipulation of \Rclass{MultiGraph} objects. Additional functions will need to be implemented for the visualization of the \Rclass{MultiGraph} objects. \end{document} graph/inst/doc/graphAttributes.pdf0000644000175000017500000031304014136072220017070 0ustar nileshnilesh%PDF-1.5 % 39 0 obj << /Length 1122 /Filter /FlateDecode >> stream xڽVmo6_!쓄UHY,R,Z x؇[vRx7Yr6 %{;o+"]*dZzC|"n׉o᱃I<?|]=YLonwgW&DZAӥVfÖoPe+`W7q`qT44s5 5[0kF0 *^ XV R]L($I Q0 )0:pTӲ%8Ҧ",o>'e zGu'!y>1Դhp-WmEmdu>p~|j$~$K7ŝJH'{O8_6]l;B!eAi GoĪGn&#''\܇5V| A0pQlzCqO|92/LKKS8QCk%肃o1 !@*xcfTLJ?~rL%wcH7zg#vi K ~L>3#gMSގ5I*#us:EЩjP&*'zFP|i ᙓ;ރf2W$r1WUAEY s69Zǘ7u_],w^+TNem-h־49_M0d >sd8;VWQ_|jmìJ~9q$!+=k`旁J%YHkaaØƯ0.{FlpK\q!z#ZQi0|JH>{``ťSHwFfIk_uÊZ/YoǼ^6'w_LNwP45祵,[0RM\t>fsceπ/O|;\N'гHGni%nk 3aBNGgoW: S7x?: Tp6A,7| ȅqZ-(S#JF:Sp<QxNL9k endstream endobj 37 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp4JRu7V/Rbuildb2e2112106a0d/graph/vignettes/foo.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 51 0 R /BBox [0 0 432 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 52 0 R>> /ExtGState << >>/ColorSpace << /sRGB 53 0 R >>>> /Length 784 /Filter /FlateDecode >> stream xn1 Y&vVT #@,UTLf2Vu|/ܕ#wkEa;R9_{my;?-_@tr{:V-NKr?]p +-dwYɇ$G{J"d/6`nJA|Dsza^ORU\KVz91^,_nd^1(X迺+*;=g ed5NzS<$v^ϻ?r\ۢדȕCظ{!b_Ƞ}4j&g 7M @8G-`a6Ꮗ8׶$4r½jYt{=zQ@{]1_BGUT]l9/NU'ZI|.#/U^V5=8f6uL|%]n{~!fKN#ڐ@:50!Yl pSDO&Z*aS4M|h605: 8/hlx}E` d4h"^%)lSz RB*겣P}_ [P5b T GʁVDT`CQmlp5;WMTT=wI0F #=6?:1}bh314 `1IvC@XqBlڎXф˄8O|<:vaյۙ_n'ҧmJSljX/L?'  endstream endobj 55 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 58 0 obj << /Length 1309 /Filter /FlateDecode >> stream xXnF+A$`v-HL0풋&%äG0OmE$KC{UUW?&vb]j'$+VYa&S`h *C 4g *S2_$!zX3U@h bT)6BGseo+\98O0bI-Ry!3BhVMHB۷+| ٹGaJmv YD>̬>$ㆧfbLn0,{#Q #apnw%BSN祪F:ɘ`]+9Mp Pi #vD@.oC~!.`⑑P~;n;_  m`'%GWƗj7#fV"鵗hYKHSgԅBI+N:fiɤ'/ex0 (| XŽn,"h6w\Q%Q~ f¿CHϨ@dV? W'?'ah c:GYo]Ӷ{1cja?R.dž(}?F3bjPmڋc9{7T|rwC("M7Xy\s;TqB 1i  孌Pz:+}21k?Jl|FjdNث"SyUO 6>|ƫ{ ATR^H.K Y׸Om﯑ cYvO#\/Ι7TgC6YÇƑi#mAoDjeV*M~+ӽž<`4{icTS:&:e걚|Cz> stream xWo@ _M<$G> @TaC"MӭRLM B>;%upgwD{x㙗fB{I&E)o<gXh}ŁO:|`ʄ q!t1cKfeE{P]sT> stream xXYoF~>PȢ-q"=H")K$4@|gvfɥ$jٹvg|;9S&An4fr0롌%ab8ZG*j;*@P>h캌6{ [)vC3b|?LC[ZԿq -.XWM ˗9|;:=׍9n$aw GTYqP8yYwAf[V} 98&qUqvd%oXsCҮ`4ge n)$y&¦7e/XМib*[[ #|ekH= Q^Q $JI x APCN2i E]v8CZŭppr;66'QS(ˏ8 r+oP3"NMC5p4h2'WY;'Ё*?}Һgke ?¾&v:YsC!Ķ,ɳ0SWiuƓWC\ĩ^Ox~#&|*qW5Sλ d98yΊlEAl?-Xm|cD=j;"F]Lnvi67?>Oz ?p6:U~}~S eH@ѽ$,aK>h2?#x|[ybigwd|9ۼsP-bKf8 ܦyd_lkǬ7\qeV&2AMXAH$̣+|"L.|*? jRۦp]mFJFK[0ˀL:kT44}D2e`1Eg"=Ce)’]7SJ ϋ- 8WP+M-cbֽT+ʀ"1џ($GXdc|+Y͛Y_#0갹4gx3u0Dxk]WdK݊klҰ6CпY/&;+L\%_>ZjaR\AZ /ȓ*%r { #3{Km6#zOߧCy<`w TB^85.) CxcD^NtU endstream endobj 71 0 obj << /Length 326 /Filter /FlateDecode >> stream xUMK0W3)I7D=xmîKҴ(;̼czT'{Z2ÍW2\2m zNN2_gLB/%p \7@3H.iPcdɇo-_ x; Uڪ`c:t ~~cұ %nuqQi-ʜEe_2"/ bU#Gӏ2) v3ZH< IM!USB@}JH}o8:?.(a٢-N[o,FJ| xIqI娫 endstream endobj 73 0 obj << /Length 122 /Filter /FlateDecode >> stream x-ɱA($ \vTSHB $:@\#Q_TQUE&MG-nu8M [Yð,ΐV]'v=WN;S3uz3x:cE_ endstream endobj 84 0 obj << /Length1 1736 /Length2 10025 /Length3 0 /Length 11130 /Filter /FlateDecode >> stream xڍT. C)]{qw !HqwwC)Z\Cq(8] ̝{VJη}BG&il\i).N'';''7:6KN rvà2vY>d,\T`Ppsr , p[TJ0(N u}J#` r- W[SFA^QQÃl# 4A. gwwU Пm.ʵ`֮ .OnP+3)9@KQi+௻ps/߁?-@ X! 2++j{pC,,  'xj\`GWv0w<ݲ,JO >]ǟ<k0wVn:PHQ/'?2+S r<k{9P!~~j ={Xn _+sq@W% E'd'~3`=.''zY/*˟yl|.ΧOn*Ba?}TZ&R=`Ɯ|/gQo$߂ ?Ԍ?j 0/'Һ>- i ksi`)Z<$%] +u+O)c0s~Tl\{Z,D?TP q,-ПF\Ohv(Ԝ/{|ߢ? C$ p8A<ГHI7pX,-AOsX >e r8 >5|>_)2oTp8>ZxO\<\Opuiz9<] tsv~zضQv@ , (lW~]#I9jnS/{%:;d`Y E_-(aImw>f mD}EP`Ӗ`ߩDM[㳼/FBg75_cܿbщ6(˷JBFgry#R bo5؛oV>hstҒP \<IU".+j.W "n`1s׺~$l;i;At'65b/wtj. zg‰a ^.,ͫTOc˯3(Fvr7$[iZn81_/ߝ\8 gNT8bx }=ĂE}%'n'wde:OD5r8T5`z ^037CE& %TAVy҄~^Pv4+|&lK#1/wM#3 i\Ե>>YD)MA͖LBp$_. T "57Α]ͬzM}^dK?`܄ r$*,g/'" ^LMO-ۡ/x&VR[%_;-3 axF xs"{ п 4N|j(Q\hn|5:B#U(&)zZ6-UϨP+adw?|8TXFs};;N>R" 2d/S8}iŐ$΁uu,R(W3nqs=zUSnq W+7HKVynNwؚ5#>"&J g9?mJP5dzw YW$`/~@·R-yi>N8\~S94ozn߽兪'#HVz|PH>G;1Ƞq`5*†̻W.{l` b>~8t=ŷ5 F%YT[M\P:TL>.Eة\qZXۀ!E1w*YJ'-h@m#l1yb l&}y %fw7u"cedxviGG)B &=If;oBL99vg ]ͪ&1Ma#ChrGr%Id!$"Tv<Wˏ.?Rm~5_;F q5' 4&~L+ }}yl!lۼɛ`~ෛ[)Ɔ7D>Oe[>B#j+a' `5 ~0⸢Ol#14BR9 zF>ݓ-;|1!ŋC0e闄{-dwd z!9\Ύ& HߵxrLnxj͍}Xnd^h2ͿJ]e[C5J'Yw!F:-;Pgh6z`Hfޕ.T/$ૂu9XL;$nwQ.j)|?'z|/p[V9BOˋ3QشrM՜=RP,"Idt.s S 횭,.m`KחO#FM|*V}"+ G쵍L*nʘLV?2"Con~ӗ?&ofy$ٸ!p_iw_&syȟgW 1}R| lP 3gb*UciVT)[O/YݔXԅBr8}yW?cMysi0B (Ė&ux w3ER~>urPzaV_Dl^-޶D-zf F`Y8+yĊORW;@s\iGf"280E:=1Px +J[S:3wE_n6 xuE+L3*%hBNA%*CDse ?W}'Vfa,#\*EQgl °o,U1vOd3|3o.i!"E|>.ڰa\Le,,03~-:u)@Mp8E\mv/oo w>_`Q-sTeW8 5`_ݲs Ef- {e*\Hn,u,_S5-BbY7;d%F1dYS#_:Sť,(vxyl5+ dv ɝ[v3UZdWS>EAf8t"<•醴Ônb8+.f_S+]\#KÆP[ u^F̄ESNo]F#T=\M0=/ѳCr,OI QoKwם%S"e㬬56lÚ03M\J0jfv#Ro켻|(4K n/^9uo8<'I/܏6_}K WEd'z8ʐIoc_IckI6~/fel#ғ1t'o*a;Qޣ 1Ü"YWP0PV;>hF^=a:lMt%n!IZb+"O:1Ȫ@LP) ؤFwZ"-iSfD%jD$[ܓ$ _L vU! b8>|63r|?.?duI8Xړ<^4_b3K(ij~Փa|pO|:;s$;b<}XÚM|Wv| l#pök);^Ia#Y.?wG\*SHP%|VN]+upʿ2g .%C/gԉцizYüdL?6{M݇`y7u\6Qէ%zK2ؕ~3)نOy]/C\43͢EC/ɷӼKA )8U7^#dXjA*H ?x,loj4Tbl ?)L= u?#[vlh.x$cp3ô2S&++KfvIQ-=$DuЗ,2$~Y 8DZScw,Epqnڨ5L1R{6$mGs3hTaO taStsn -s,Z2&ÉQ$3 NoX g~lQ0 H뾹("O-F*E~@kueH~TZ)DM$=LW,dIM_R6sqFrxܣqS{e=qzFbN ܛX, 䳧$s+F@mU^yIi6E--nn|yhs5p1Dž&|^4y3:d&ǝ:S0L=ESHkڠJ;.mO@,[ZG;IFAKJԬNF,JogشQiB]d6'}?*s^ G'%\4L#4N ȼzGJP]v5tKx+~kݰH1y3BwcLo@|T )0+svT)}fWQݧMDGT Q"o@WDm5'Y{&.VEܡ'=c/Prb09ț`nFC>$d3miud0L!Mc#4<"7wL ha[fmodK[j5=_\Ok-(\YgAu+҇&+@tK9+g3 S?jt\^;=Rؾ/3--S%5'hS{=Wn,%uqVx"!|=sK> e_z93 F~bw8LY=lEښJ*6C Y5MsC* ܪ h dh΁/7*j;-LXW#i  Wk^ܨ*rz" M Ic0'^<#'4]й8珦N& Vfjb> Uf}:٘3||G/$\uWHES:AL4hc1/ĪoovPGg?hg:~UKzd"JRu/~)kC% B!v$h6?^~d dNHFad Өi5pȘ46gUcFh.4܇rՑW6{*?D:7UYY ;^0: &_^S]w%h\EQDVT ^TgFO5/wȏ~ ƈ8:tb2۟*#9ܞ;"ŴcܥRlmݫ484U`D*4(C^z6m\Y\P;֮Q+o(8P yf'X@X6O,5w.-1-ƪf&! Yc5NF{T_0s´Zz01넹U|[k8D4ļk]_BAQUZ7ƺ[M4P̶MEf{,YROwmQxGH渠iG1wԴ8K{wj7c㧷53wHi‹*(nc$0jR]+BTE+okA9>6C%ѹ.nT wӇH[5`tݣfy/;)iUٹK{fPPrw}lD\m@P>._[U$2/QՐ::z.Q,|pEhc `s.<8٤de-G/Q42ΰMb'm<"<{l9Omt$V0u<[?ULq{쬿N[ച[w0|~|x(P^G=rN N#W kՍ3$.;~d/NGEs# P}lY!msjF -̙*(ޑyڷ> stream xڌP]۲ 5-ݝw  x C{{vfw1ɈUL팁vtL9e&F## =##3,5?bX2u-"@#󇝜-@`bffd032r#7@ G:{8Z[8&T&..ڿB6@GK#[&F;K AklFodDohOE pt(@S_lTFKPtGbgf|-MN.@G*R{?Ʋ=@;zXښ,qYzgwgZ_FNvFFFgnR}L-흝,*0]5:;# [;7[_E3Z:Dc!Wft122rp_U=+Teog0(cid 8;}ToebZ8斶Fwt0~>}ǿ/?W',lce112F?i+ekf'ۏ6OƮ,ǒZ !edc4a< MHo5 >c>jYZ9J9},h$n4Ut6gZe֖@E;'˿j|:>Focs+lMLZ1f6v!cM1Qeg0% b%F `X R;A__S>T%V`/q}ѿ `0>`_bЙY$Ill  ~$i/~(/tכ/>Lt,[ͳ?~g~TnGUۅۏDU\@3L$iv~TG>t?"`ppďlp?6?N7e1qq(c8@; !\7 Y}4*:evgOTY{v(W߼N?$*x+O.Ma L LJS<~sV )M‰X'|u,da_頚]|.Z-JYq<13>45;YwBxXhb/-昧y Uf.lRlm,|{Աir/iEⵁ%fb\5:d#jKHZױd@^bmYgGbVH4Z/@3_fVx+\3?sZ~M^/#t!-Í#>ݘ,t"V3S!˝4RiW\9_!yqv9!{A.c|*;PPߍ;S-X B(3ź7b)x s W[e ;lK׃ŬRUVO\jqlJD{gtG C}\Lv~}.~ltU&<ޡ夐.! V; cLr*Jd;UF[.%JFQ,/s꽬$Z܋]'~\׮H Cu Nb>ܨ~GWEs wqf|htz˺Rk_-*:hq/v2*YDӆP ^mplh BS; g3I@QEֆl1lg&*'ݺt@I7EN`^ٓsg%lfD`YV-$-N2`dREk@DBS|MVFSd' E@=%(TMW'"="\B^ K>;u: 9xP6(hF,ΖvF]o;q8 7m'o6c7t;oe}RưF^ftCCMM0-G)XNr-"/+<-$ {zs 1KeFse/,_Mt7.t[ZXX]t2 Z j.TD0n~bubJZ}9: g`='ehЯ` SubJxh K{R"FP2+0ΪVK)Z?W4%bntaLJ#qeə̓=Cǰi]U0ayn$αSgR |~(+I0|ֽ2u$(ۍ{R=ukOC65aO]$9)~up(q_(T=U@%uX arLj$2 X&gfuC-; cָDs[8S2~/'V(EG[g(1(R NUJ._TŸ>җ25(3 , Q!S!"[ MpX:uߏvi]ƒ/|X U|U+8u5+5$EQ$8$LVեSJGg1a _}E1jSBwn36\Z62E0ot*AKFasJKFWsCB=U"|~0TםK͵;4R_4G =7ڛ|e#NWv=ࠉDD#0M5|]0bm;)M$@mBFnYyL?ܗlbӣ5p۠Nسj$47Yu  ~1WԨ{6e5m,#Ǿ8\'k;D”lW"Ƨ2M#GEwV?>{,UW짆hO*{ҵV'ݿdhA_Ur)LJ|̓kl-+”`Iu_s)؋dQ+TdJSac."2lMy=@ MVggxFxS.mEHTni7VDtޕB}VLh%<́JAibːU7d /I@1=Hng[P,tBd-ʵ80b)jIOpADAMcj`D %oNS>fe6JZ :;L-TWO~IZ!O&=\ɨQM{f66 JHC%\@]mA8twkYo*<_AO^f0aL<-%(KA<0s4GI!Zonj|H2RAzxb ,rU  t 7њkJl z?B&!vr7P HV lV Y\ [(|j_g{Fμ Ī.&썎,Nf7^d?>Wrx:ޤ&8Ұu{|%z[כ~}:CTpΣ:䖼P[2*㋫wvp9꣓۾ Δ%U;w]!@ Wi‡Uy%fY:n%rwQRp-l2K2i+ߠ =*Ÿnhز+!G"Fȏ~.lJ^~oE\n2UچCsY? ^=.4KaU6x 'p)Tb&bR׳{>}y6|/z;6zŔr1: Q<3NQyp$7whC,. >U2#M=7ğ :;`R)mVlʥL|-H=Ew&{Zi*'.&:o}].`8g kaG+ 9/FW%C:Ȇ3cb9=n8ݐgF7FA>V#5Â/>H?!?ۆ:Ť1R#z!V[ hyF&F7rN_ Kz S .;Z\G[u_éޔFK͂iV:6rayNߚĹԋMi>{7WL=S zgdc-/\re~(NH?(Mk) > Qe`v~{r/{%y`VX5 >B\)v-ydkZzUkEj|fYHAXgs+4 *}|>)k J8*Vl;ķCLI_gO☦ 4N{!ZD#U<=iTx9 ³<Q32sx5,  ߿nES[Z4|8F a a&$)@F϶%WkDx=y{ПKI>Q H̱+MQd+ 4q[59KbWxwTv׫ijڹn~g@9̟A'/@,ЭWꖺ"P>\<ٽX[Ajj,.hJCJ_r .L[I }JN .Z3능mFZl_ 2ݻr#)4C$٥t Ӄ~r ϗpQK1`6{-C_x\g-+nPŅq"g=QU]E;qoZ7WY|r+jsCkL%V ;(hx:y׫Es۴}b]RcÎ_aڸ*l jԹÊiz SwzUto1iZBoPd,شLz ^nMnSнV*C $I㐍E?%+Dv{DBSɫt`Y oQbiNQh6iZAұY<Iw9i(4_g@L2Ggz?k gK/: cs%h/PZ䴈5zhvbD\՝gLPRZl= p)ԫg4l$jwjYjIb'hMU֓#}<#,9᜚uwl=3Jl YEoq%BRmqBv3J~~=W[-AqwNr$QY΅`UVOE;MB֋Qqj v ^)(iD cCn҄MqZсl}dxu8mB-ⴟLhO]bzYH/Iƣ0~ \V9eORTZ3x\*%|_mim^2|e/Wgw$b O|nJ7XGx/;X4v۹٣ukފh$1$Tx]R!)._W|i0{Wɉ9 X/8\Q);2G卐? _mz'웷" %!չ{D ,>5^+HSv~o<kVtB!!]i[ОhoƘ}pyidAF'vM چb C'x p,zY1l2;ܪށ*Prp<ѯ]3${('! F)sl{!pF Mi>A˦|M=jaw",Eߏ7V̪ s)؝uGoTѪo0uJ]/:FbK-&;Qcg@S4_ըj7JK 9l"7F@-z1}={Yzh\2܃A~f0,=So_'WFIO\1T$Zњ[}%.d)mQUzi .q_Fb]/ݢ4ft"ꑎt|ṁT#\d ?mf5CZyqצFE'4̸W)J"{8e}p9]IF kT@R񉹐HH~n/"{8VpOE o1ԧ$+e:ĿgV*i<[Q(vgwȯrl-`h,y|ǐX\ڣ*"<؅c,^: S@oe xENfGмnU0߀贯Y֙B]ܦ۲<`*GΐvWAY2[>7ӐnB;+4 C^sEQ=9݂iAr^Ҥo(V8f8s2Uo+Lr?2I6&,ktV"Y2\IV ǃf!mv&V_^wOmZ"MEߋݗO yFxĚz͘uuпx{8Ii~PBЍMei&9JdX{w'>-{~ I.YE:X]X4I0((@![x5h*fE!/HvPzƔl Ԁx%6&U}lMx0*T"piAҷ3eV%M_Q Rȃ f^^3XlLAU%sLex cUVuf¦cܒYllZjS< "uc_hB%(`]~(o=^ ǰyhvpgdpW}QKuQނV$c ;1*J(=)驹BsK$8D9x|)X P:3o#<mn+J=FCTY7t%$]%)p&u k-?Whj ~FD|cD,:U7*,%I"9J *D@>y`\4X/|)1Ue竈o7U!`~5}{4+,;6M! ZUs~Hm9ѣX,)/j$aAt ܑxERZ~!#)Y5N6}bMKfwOczqm]m]HT%:&w&4oM^̘j+yaҁU7fZ SvXs}B>(*\4﬑hbD@:/YJtq_1.LT9CPc;z-Jiq|{iwk|>^p+ynYuA8z:JI(1/tJ&EIZXζSz^Q7 c6;q0n*9.;Z[\d8ϭ_뼵XG[qꯋ"Ǫ=a#c<$mXjdoD,b.  U~$nWnF52}V Cg] J(,(玲2Fy[ qc3$i/2plryjU3yfN/$ȡu8ڟrT.Qźc@%5hyA}@@k+9!LAV# H`KP8{Ӈ^*hx [J-.6RYtT>jRb69/q$q%˴\ܖwb( L}~o}?SEt]U+{|`kّCE51h"I84ց. ̌Ha3iޝp;=z*b7uĄ8ou'UntI:r"삵~c:wPqV˨ oKêWj u7J&h+(\he_ݑзm r&!]8PVww#}#2<.FOCrͻ *(Cm$ܻ\iɱЩm vb3tYx`3ƸDK% NWMhIݘ-0nZ%Q gpSt^n֝چV"LoBv~>}~P+OhP(C%c9 f'`w"<@7Cdۦ_sÞ0ž LX.y\MޚvOFBꆉ] ]e%[U ")Z"Pݲws% J糒"|a_.L=8l9/3 bC\g~Z,ڬOmS|!cEqM$k|l}h VCB]g+~r!% .0},e{a9Y(;' ]#{ҭ6D⊮bP5hf.ςy$T+7t@VDaBahRbqG6W*;eWsFViKvJmSq u$:6`TKW/X(8x,d;dr7)1tMϑͪSsѨ@KH'F"vjXu?'NII|qBW|J5遪&a`poru_]}X wB;&\{(ns dZVC(DA}`c=TaVwD%.[o8wр/ ȼ{Xpu҅uѹL@]-7_2v_dYIG^rS9"2("+1L F?a~53Id3B}|3_3m:'qXB[d!ӱ!HaX2N P-,Jf܊=Qk  T*TTX^)f,܃jr#rbi0Tw $ ξ0 7:qܣ&,Tx9Iz ×L$'ȩeapqyoG8FkXoI25#q iF_9ev%\S p hi!D"3F-#֢ p;XI^lC5(>Fyc=sREI]t gp5@t9YHlS,Q `Ya”7`BNvZԧ[q {qU%JO>@½޶X|D_+nw9iZ#.;30|O+q\Tq 9+0daUqpJK4c /6WՠV_^eMr< ~gEcx*鉚+h|CLYmjT<뫳g!@/]P/&wBni]Oo͝Gq _s.u\ 7XETVnd+]cfpѺ~،Fg|S?"26 ]w68.􆅼k/0"$b3Pk$bew{Ȩ@4㼄u9"XÒ-u`wmg$-brKVEpDg&0YX-6љ Ҷ!&m(>GTM [o^ UWN;q؎ ^+bMw-Ӫ ] \Fd]dz F]8P-+a&D:YF l(r䰹JO?aR]0UyuY! Mv#vԦͰ s_~!ԗwtʬX \H`}RXl\I:UJ.R۳X5`Qy۔`=:Fp.@OeؚfggR0OV;pԅo1)Ihv"kvf>ʹ[ 'TǏvGXoAp38bxd!"Ltg#ׂdFSH?}'a=z;W4 E(<p|;L["E"sMRRd&Fc [rL-Is[F&T'ߔe yTbV:n긆NW4j&П9LWAAt1OOZPM:*Un[elldiBj:eQ,A8ہZ%F w JK+tiA:ޙϻ,k= BG 9BQ`7MU\;^Q/$2s&80}IFKDv@"">}ofCOK>\MUXhcm)Wd5UT"T9_ȕnf]e5FTHh׷! ^KL}ʤm "Bd{K)09oR<,epbJ[>"r VU:_kBH@&$xԛ.ÝkV톺׉ayz/f,MҥaD^YtlTBz.=GJg~!B%WlH]U Cqpg(&E&)[P)Q P7HC$q8iW{[U-zxc D#w}ZgaGGo0KC22";¼N/Vgqiݟ( ;L#S|'X`=^*<W3_̿CTtY**z<ʍ dM"8z|܎S.vq^{_s #o{:aKj+-Z$)3%,iNyFec=k`v+ `՞a@B/}[r w_eqnXLזcc5VFŪ,ҒWSw;.[^y/x)0^%Q.c_ z㾥jL{L4+]cFGxn0FA7՛v$m'gbv\zݴ|i쨮(_U䢽 TY:4LL}H3c1]dՏqpS"Uu!L a2+_sRce;9dm3KP(oL'r{Dep40d \QWvɓّe=C_/|~uiC]6=QT.%aaRk(J8Vmw&ǃ-=.X0,3WqDOBgK,6-|ÈBN C¾r\'\YCR7Ȉ9Zֳdֲ p f!eΪwdҚВZ.$,h2miB.-ڗR$Ht,KGWO*X3כ&yi=Qɧᔢo1[tefa,f[ ݡ6NqB `kUrq$Nq1c9ulq#a A?}-QE9ѝ2YZ}?C]}ŊW8zY 4Lŝ]>S2H؂#y`+L󟳛ۃX,a%61 `&#OLTg:RY Q.EU+;侙./mon/^g7vTq*ԙ/Q]p嬊hOfLajGGO"(ϪEԨtTBC1z6qz/ϕZb pZ]~ƍ3$^J]>5{wk Šѿ-aJ6*t6o7N-U$738ӞQovU+.R3 ~v!r%l[̚t}\Gx-JxSN# a$yɱuTL/2(`-y\ktGL[?eCeRVNTVf1p[9V͂vqbD_@DL bS7R#NlMRj|#U .L[& ]*E 2͒c뱝A;wEbBUE]Zu0ވ7e=e:A-eQ**g*A7~מ ç tmgH2@?wܾ4/H 1f@ʦq:f>tr΄Y;Q;k(qܶh '(1/jc'dWgA )xp*;tH-!Ǯ:ᗯUc y 'ĵu}{ 5 qtA$(|z'9uָE#YbاX)؃S!z$]gO,ϙJHrl sj{4B9GQ<}ՓHB 6Ljƾ{w`(n;7?mUq+ DKяy, /))rԱ|[[-ʍbF+wd{CgGV=H?8pL #'B>TX63Xr-z='_x?iokv ?Ո֜ӁߪloE= ly+] o1wOD Y:PsRUe&G:9Gn_7sɠi(#BUŀ/^S0v'iW{vg{ [XLCrv !I.BE'&e e W$v;1g$ﱉ6DTP K ҏ:Eޫ;K}%ٶڪ]-ny&볌籪0C(N77H;MOv_xKp晜K7=NCw"aB-I;Gv K1UUq<ώ=hS,1bWl5{ϊ"ڏA6#l˦ڹQCIn6˫C@&;'_쒅{+x ѣ:{Lo*d+"_v9Fg(}ŧ w6 or]&Z2M9;Ƨwd.~J -0Fv-Υ%Ťlv xЖHn!NjtngF{ \>NzJH:йɍJ(>r0t i8 oU&KpGCGXG$5i"0~aqtT1ahcT1R[6&;P\ǡ+M eQ3[]a`$8[Y4J9o 4sa H]ģ~Lͭ/Ȁ+Kc`9KWRa@45 Z0U9Tl௖x%ϭb0TȅJ$s=;+:~e8'ʦ j-&0V?2!o5r4~ |$iҰzD8f^K|.u ܡP;07@3wP 5l@ ,$7.;.}tI5ߵ, endstream endobj 88 0 obj << /Length1 1620 /Length2 8633 /Length3 0 /Length 9693 /Filter /FlateDecode >> stream xڍT.S݂^\[<AŊ;-PwibHGg̽{+k%|g}}eV%g'x1pG_fLfC;&y7hS4a5GP&PyB 3 ,?6kvPLLt j 4@p; G5/ 6I;8Eˋf+w' 0@3LfO <c q<SUh@`k6 oAa$\@0(`uyp.rtw~y ǀ?*duj wq:n7a`yg'' >q>ެ 6{UBMl!p x[q6?vyl<`=n?\#a/$ |0/$>"<0gc ౽*6Z#QHL xAy#AGD ||$sk >:Cxc/#P?.?na/#5_l'B4`=?8?1b4l-fuU'KŽ,Q;ߒ[ .z*{mNȆOԱw;l2tw~_ۛ#:u:Z$Nub.~$**8DAͭ/0WCWkPٻqbe"|~Os3ۊXs̅V4O8O.~O=Щ%rb o]]w`0&A fOS#[++pHD=tgԽr;83gag E&V}ѡ> M0dUm[LʝK+ ((%軏F#B׎$6 AȂYg;rKn:b6F&kHm|O?=:w;yH|:y;؉19~]Gj'k\bT9YX#f {_سk;0"w+ *dk DsJ0T["&=H?n+FlEݳU;9?6+䩰ՓtL!2JP?-2k fH؃@`9"b^k"kT=y״{^EuA)$(|Ǵ/m(;EHR._hzu#o+@`>@I'O^&nI^ DI=FS y9|]R@oImaL֕E/3իI/V`{𹹦gqKL~`{Il/\?W$Zc{i1JU,J:G.m=vZmگp¯ O~;iW{ij YE]NBQlOi4*L;5ѫqOi fȼgC[S@ߌ?;HY}'B-4h<8Ǟ~_I3J$&*VcUAf{W|:ޖuy8^3;H#I} i9}0mZa!F%sM QC/:u"@˔ȞڏG_ 37_6tW ~N)PA&9d݇|[*)5(Ϟ!2d8 jq,KIne_WGQBkfvy(Q4\A֛ci~ՖN\%HRBfБ4Xi~["W"7-^SɁȥO6 E̷/$q05R8qbޔl.g' F$Y\뾙wR&ll ɘ`[\S&nQOu*$|:)h<% )/c]HmŻU3ױ>:Y$$X)[l&NIZYr?>gfc as4V-8[jtMdQ!EبM1NM+NyxV#EΞHFSx}heF;ȗٸq/ޅ F9sdpw4.pS//.P)e{It;Vשģ1G^%%J$zS-}xhH(W$! T22}n*E>K%A\oPsX9Yu.~ w1^"h~X+!'VPתFሕ2'w{gZvSj#Y]Ro ;k+ >[FƧe_\ G jD^Ȳ $Eղر)kRfä]@EѦׇ-hz(lK[&S4sQWA"CZtճB07TPQ9{aޛn~_H R&bՋ#6REUaftVd9f5ނvgd8[W|/`~(|G5NcX>/PՙRW'~,UN26 6ѸL><FHLX]T*Zz>:&*\0,=B#YPp㝷hidS`mXj=ʛ7fsM٨4A4w3+ DDXnu/1$U5.DŴ'x;#)gh},H-W+#"" ܖ#KL(4Xc>`?e"LvÂalaॸt9g˷Rqw$:+0"Gph#5T{1T0g[7CZ<_ż:܇}F蛳mOJo7W&Э2V( EfNWg4Zܤ[Ol~32`Cn|XS _hWSKIʈ*N CZG b0 @lQ"K\R'u҅Jby&":DOk4bDgH5PbS97=3g((Hŋ1fرS\|sJ:FilmqmAh/(^ڟ$=Q6E=;YG7e}Qs8qHt>Q,MTgB1!u7 VnP7^hnjr -][[=)R_Z{\F_SHukd*3@@l%QUN9޴:鴾H|q=Й8ClVT[> vՂud0ց^Yd! T5*OǦ#'F/:<޶?\GI}B%KԬ% VoWt;64nrml^C,Ojxs=z|νP͘g221_3.mjw׮CJA EQÙ'KE^}-,>bH'\/J :Yjz-/Ppyf47|*_{0Ni4<6xUhl%4l(~) `$džy\|s ) *ˑVǣ/j=euVn@6t)"* pEr"kswMBHRl|OJ'GsAZqh/|o4oNeR}QlDӎN Fq; /59B^5{xiâ7ݢ59W_it CvU^!Pត[8|=I,spM~T?MK#='L>e.75;';ꘄ3+ =wIBfRĆ M{cw^ ڇr؅ruXwk ŗN6ek#Da88b.2o ".-!:ꕍ" %.}8`/fv&N\P>K;6e>QДSc=Bl<#24 .<zy~3m%@ o})#r5/u#8>%dgj,}NQT(;Y('D\ ɵ]$}y] ,W᩽N\{MΌ`co!wu@.$L"i1ڰZ~nDBP]V/B2Pr\_OcKj33k阎&T= *{4asCrR}syP1[rR뇧<p.֠7ٗ?s%4zTEmGR6"Euȏ t].,YjMD3P ׷>P"t0mh޴r[PmbKָ}ytQaRxܵ6lK騈w?ܑ8^qQ2V;g/p]y-.#L5%)D+IW ~.~V_ H~֭e釙_撚Fޗu 0*5'XOWtJMV; kǐZ u s9\IdYJŖkױg֮ olV6rLUF̍m>~e-?V1 ?&$v&NTAa{h9|u8u uL~:'CnUr[hJtf2Es,Py9R;z^ׁ~L{^ Ze|cC8f7LwW9CGCo3>%" c!1ǁ_6[j:ԼamBw AAZ2w6Xv|&koӞ"}b=dM=^;biLVtnd95C_=1/Ly ?kj(PBgGNSOGx싔k!g[7$Rᡜ>dHQs>}n򂮭+ &5*%t2-0>ҫBQǒ/Ӓt402ogS< gN@ts7aNZuHK^T<84Gps3 ŪT޹L}8;[('X/ sL;:tpڬ/hHse4/&1~ 9䂾/&~ZwNC7wx!qx{"ר Tԏ6I`UU~OkRmQAH`?YGn$1dj;ލB{k@kcă@>dVb5{&'NZfJi3ڼF49'/"Y !30NğvOJ>D؜(~ƨ{+%]b3sxċ9Ji)c`~ x)OOvQ,mɃ+WO{6 kF!Yq]Bȩi/hqh`-A? a*ij<Q`_Bw-v)ewYP1YMA`tV(L(FF׏{b4A,:aZuv& L։N 4"RW@q~QslHHQ~3cm~du{ WZCJb/з6e<6˞n\EcgI+/اW6Y&l -}^H*qȱX(oB/kJu20{,FBL/D TwDTJcS '`Ӊcڦ -lj17#CW-kgrH)=5OnI Z9{ã/2OZ_O`khr ׻8\C5|keLcnCU)ٗ^/S: 8Z%lV64Ey*R5D)H݅׹ދH~2+ ;icA ˂!𱅌*a룯 SAkݖѻ rn'i07UnB<ˤV>S[j@ &3_S+''8_+GJ)b%-]SLZ4ӯ8A>,냪%'W7^9`R)9V#BF$(78tNRW 6,Gɧrѽ ɖ.yM ]펟vH;eENQj1IS t_O\y)}&(>Q&{SW!7KYNv&/*6{T'ҳm$R9k9Tr^ܳ8 xc _Yxc'92R]Ł^g埿XǢF7b"$V$=e8Pgަ4gj"*1͵J4 JMm}hnnaɗ}M\Ĩ[DF'Uޫ t?߻/{I"Jx%>6+?pF&pSJ,d.ībJ 6cq8l!!b[L/Ն&h%{7­5hs >8,o^<~Y֠˜-ƂHIxiɋ K~k5ߓT*ź.<;dyvl}/_t_x`Z]%eyu\Qlގ\pw`zR.r^NbY41+ tj{혍/>"Cݎ \:FlV)/{6#Uxreܷ$_>xp9gcRE+k %% $Tۯ.S驝1JG}}[|?\ڤ*6xx&!;OGX_q{_BrnYV=K7vE}[~H!0u[$t/aD>Ә3>.-| zɍvC]*$=yH7HyyhjHFsO΂.Sn"EG@Fȉ'T{=R#+g`z(m?X0gBEO+Am7x/ YH`*@ʼnFՈL24// +1;-B@Tx^POTC;5C[6n𰊙N}#H$ƢuP jDp$|,'R;@xB4)@o8 + *},\!AyZKaV-s^N7 gv?&_f*DžE.] V }CŊwsT9>g~P0eВS̨nXE)q8eMw'U >ypi<#KXiUc &U÷AT'  7?.q@gNSF!@|6"s„Y}=̨谖~IF+v*3 endstream endobj 90 0 obj << /Length1 1597 /Length2 8599 /Length3 0 /Length 9638 /Filter /FlateDecode >> stream xڍP[-Cp`Cpwww%;'A \;$'8A.9{ս5U3jYOwջJCMjBٸ9ҪZ\NNvNNnT::#o3* +@dltSBJ.+!.~!NN7'B]2`k*;@ IC}\vϯG# %(' r-!UKw;m( r/ F;wwg!///vK'7v+ n\=Aր ,@uƎJбe׆ڸ{YG0q{X\/h+ԝAU `=;MINΖ0`vTݽY߁n|KOKs-rn vvwcw;n7e!P'' w}2`Wy>؀!6pЅ]<@2))7  Ew*Bl}3LR>`G&|/gIowAr܌gz?_kgUA`Ut|Iv{5@]9! `_:<nϊ=/RZ0nWKWWKTg!qWGv9^D_8$ ~.?H$ 8Aϑ gr6 U >S9 >S >S >S >7w? Q@pIR/ Y],&6eN;LtoB7\$GzWe/%V(Z#R5ߛ'kMﶣ.MNH cӑ ICSƫ_޻~ >RFa׍3 )+ʛ'Frg#Ga=ƚ-|TJfA 8ygɝp;VMBKbDLyOj/Chѯ],v wRa4nprf 7uط$S_o=mNdдv 'y#BU0gή֘L|TF!=ʤVoҞSbفh>F)CC YtBl/]Xk=2,bQ~v c:-n{[fgqH3 xGSc5:E0O0үC/FV-~F/%oLod#W3hH©!ўgE {Zn\_P~W\N<: ;F;2E-A ʅGpn[ˉcTS'< ٯX/z%a?ʂMem4p. d[񊷬vbvEw@1mMd 3w1հ 7&ìgVq+vP~1\7Pؖ1k&hoSb䇯GcnD=F0qq%Zc٦J/7:D_-yO)0.s z"-/emN"cc݈eQ'|5ӶȰ(1e6х:P_ u\+z.KT}O'Qb+ 7/4b\ufAj"O)_Řl2 ӉR+/<{8w2IpbbRv\?LK*seIK7fQDb EPġ5_*Ṋ|χId85eyr$"_ΐM;J8`NR?9bUֲM8H+pIʩ06pf4 j-o/&Kv^cb%iO/*7] >v?7a7̂:$e`>C.tߞU{6r5K#eKOS3=@Q-Ls Q9FpBzOLyuTu?3rupP?2ҺÅm.jh '|(*h,u4""\c09ŠB՞zo(xx0L kh+Sc:a';7H}slEmrjumd19ַGhē"qk_ClyIj_W&f=|,iόSW~+>XIQNp)|t@QZ@[ٵ xgC'Jr.mI.x\g5C.Z_OK> >0"5Wc9OW%+AO Wf IXV I2N-.ldT$?MN~ 12`8-3x(Bg&-ZrNrwwW׮;Fr5^ i5] >o'[S | s&1֧-_F ?<5wp_?)ֿF#X cxoXDaj+z21V*ߣ`BT z>gQ}=˷xbMV IXi=_۽]+K$KtoG ƜDp2U23id.؊:60/hyu1L!Lqԟa~1rarU-T~tB$m:9k\X &-H"TrK`>Jzp LfM8%e4ݕ%yaiy'Mw.tNAq6uXEZ<ptKiZ'-J)ުMk}Ң0=D)q%NJxwi62O "}l?d{׽1fQĉR\Ohm;;圍r^F~L*j"~L{ɨ:/V5/zY?ZҒ"B]԰jQMmٔ3I[-5"_MZ@e^<:_ur! +~Tw4 K_^@Ɯq|&+snUQ}"z ZEc17ZPw`*{gDOm"]/5P8{/D*[uwʯ=8n 2c^VLe+6kԑ*jb*̇E3zq'/?+1_}U&~;Odv3E|PaIX6?|ayd! } Ԛ4grFݰ(jz%͜X+u̞ :"&؍ Hq#?* I]< V{~э =Z%ʼ}DaÞyW2e >$x+E~s3yc]$l+fAogHC3SK v#U#26jμEMkzf"Y&RPA eژC:W]*ŏq-߱ͧPf3M؆{&v`GGqHK%kp;:j~k;]C ܝr8ϡy$izU3݆֫$j i/<1<'upYzv{> $Bt Tb&+VFM@/q_q&-p694lHj5˴[2okcDq^)FolT Da%mTMw߁Ư1jc_c .{);sž6:wqM^б$_ՑSU/5Zcq!j};LS3L+ _Dq5 .Jb#!A=&p'I݈@b>FEk]Y$}2ZIs_nƖ{x'/ m ylFhZOs ^uk!LRER½NzJ7Ʉf+%KVLw wk/@l|e WLGy-x)u>( _VjzZC}s7 ˙Cb¾R,8) .޾)%׾:c('86PBfjPl-.Oҩk'h]e}46 nz"ihҔnE;P?= -3zٖc6tmfZIlDŽQPl$Һ ˢ bge$!肌9Ƕ53<ާAuZ'\KF}!nfTjAd9IF7yo YVQG&vy W"Cl@A]u7#Z -dLACpMs#VJX 6Q1R6lh%5$ ;Xx|>S/oxp"ڀDkU V NK `IQN "!]oM/rN/-4J SRTgLG%]6O!PwX u)ЏN+Mp6^u2pLas$+خffFz"RzɊXKTĸ_`XIҩLH۳ 9ZC.>; ,uwvWWF94i eM~۱HN2Mc\e=whVΊt;`+4 fw+EfJE Wd8ؐ 0t$8qwh8CTZ2 `> e8[UJDaA4a?h ߝa: ٵ ztsRŠU#Mh[]djA_;^/!lvV.% nmjɕ#VG>:2懻ʺ? 1mO:k!8$yA"A}"r B)g"]@2a^}* O474KɏF( vMb-`mq7L}'c6BY,k'Ex3"Ze6T GnJƥ>Qv!Qt+;q8MB@D{cὥ`> _f8  qarqr]LB! f *5Fu.gz_S@/'aQFÞ$ݝzeX~|l\druXŻ-E^~1XM'O쎲Y;byx.7U9sX'tbhCn'O1-0{S7͙ }_̄ r|Wff 9] TG-hH׸K2r+OLž5ZA~ȚE+ ]fCxA_CKNeLyL<`B"8 /P; qƌOFl^5w"G:&zs@i2@i#tȱѰerY5Yrj:~l75 #i..7L>f\Ζǡ9EĴ]ui\o%LSdRW7XjJۓ/6"~>ܹO_/v,|/ Xd3BŞG>LMo< cywY^9(K!dl<;/f/&#潚:)13A!g7^n~jv6vLSP뫼ozlRf%[՗ja3n"gU+>5F0O4*:eqOQ&+ _aR qVb-FS xRiƠ:FD^WIxG_jX ]u9}9^i(Dұ,z|sG~HE|l#*|AȞ2Kk &yhcY:=w lT#>TY%[0 ˺$-._8$WUS?_T}hpC%>, 2W0~0oW* R[w!|Y{/fphZHq/v1z +}H H"b .,_&riԳwl7=Yߺ r1rD'y׼Y+MbD+'~VmsDH p鬉 Л*ռc˲E¨4"T  x)7֞y+,~~5rŮZzR6(HJʿNK\ F6N[?A<`C|Ip#eMԤ8 #:/4*)wҐ}whV(+vφXdϼsHzT$^,>'3j.ȜSO}snLu8*v/|9"P 8VFE7L @7{Ae ؓ 8,\{tTSس'ӬdU0)fd+\.kw!x^dmA˕?_(|X|C}ɴn&]›l.3j#nZvn^(u NJD'4IYό6VoP5o5aU%7xp^Ș捤iߍF; &EU)Dc':/};ז*~t"{pc~OρJ7]K.N]'<~@m8VD(ixdp޷$VIqH2 SZGd %!mPUf$\}fbk"T-c/VuJn+7uNg\?" h;_"RI#[͌_?JJcG>P.Ȏt\mleXlԄ9kpbXjg;E5K42<;>zu?~D@Syf10IdZu 񲈴'q? -;ٟŠ>e*dh O 9}kxp:j8oVY5Gw XЖbBqXa*f~<+kuȬcZԒ9'ٛ "e5(}|(1|1Fە({l#"݌ڐ0R4ȼX2" ms &)|TkxbLPXũM9+Pw#{~vޜ?L+LeFrSt*{,Cr/) P([$woS)vIq^" t1QӣKI`ҹ i3IS "C<8k2P,峿ٻ |D)T/A!h[HAOmG0}E#Ami/4̄ʁym7Ah&Kj?na!Eաb=ËF8^#"# 4B 9{Q_{iGgBfjP"!w=.? Dzæh2ZҽQt<(5c1,.7|L7u(_7Ҹsy -Eӟvk',ats LGA$h٘OII'6"LOOY#:Ifblҫվw.']o6X^5-{Wٙև4TR-T6W32bp`S/yBQOri+acُp!.n2z]0aCI'Q͕- ,}{;g> stream xڍeTwVݝR[b-P(ܡM>gwwd}ϹRiHX@`G7VvA;VGBrq; FtȤnSe#@dgp "zXY `G+  鿏zs_ 9 t9@2`svssdcd:]D6n +d6@9VZ*M'mA'wG )Pu9m3?pr?޿8 47;8m6 3hh =6@3_ tjbjcKa q;8\Q~'m2Lޛ#s{:6[pwbvqvK "B#x! r̭~'v-vXBZX ?(@o" de':D CXb0dϓ1g`G{?4 ?M{|Y8,\\^>/mSȿ\- 5{RC ;97r"(?ku˂&/ l vw2T+,lV Y G+YXy۸x,ḽbkgoRj,G5s;u a_*d79q..@ov8yxyg# t>Z^o߈& dA|6? &ؔ >?qB(AhA6?RE$ UA4AyK?r$?l9JK$}Pl?c!cO H%6V"ZBMV){ןJ4Y]]9'|U QW"XV}pܹxN:RSH\z̯/2k|ayk[|O40ӺW7RxY dST:D MAICkZ㌇)<^ CIײo!z[Xoݑ^P2y{Cl;>r ѺdD )CsUNuaqiGۈ]^fQS7#r:x)ɮ&]i6eٚ'-Ge/*yb-ϕ=bE\46}b`f< QP:d!¸1#X\_C |a=۱[ .@I8ֿlFUpk!ρgik2&n*-eٹ]3V/l(O#--wn!`FCmQ5+89}rw"ײT?gyeѰs3 H0O&0MSNe%2>_W+:[/W*__V>lv~"*|yˇF@Y-p?T57O!QתvW~N]Q)*! =9>Xσ液lwH!tFo[9i>< Hg4KQyc_x|^̢d n#nFRL_b#(23xeegI·H^\xcrfb7JRܬGe5ǻ%=44=bd:{,԰C;v`XO ٝmM‰Ea;Ip9fGr'|V3#zG~O=ǺP+U3_vNl _ϓv#hIɻ!(9 >'%1=6 (Z%mLJv=s(d. h?Lffj~s{ZtlQx:c6׊ԯBo,闶_2䗕#خ6s1{d{UT-^Y( ]דz3.ʪfF8Q Jln@vͩf\ȜZtcw ZoV\P9D8'k,e#=*6 jGXj_dVҀU?p6#YAS޵`c AkR(+f/orn3W=:FE`+/?B*mENZˮ6L0Zj[R֎i甮޼3d_yd`piۗYk,|U4H^jG=[ ˛5tO2hތue|Ra,V=T¹~Ɖ2~llv]F1̔$X/H)`,'lkۼ!b<-/]ؤڅ\+WՋ(BHUr=#D@Lb]vfOUr䑩ıaBn?V}]<М =yB|ˌ|g\MLtd__mJG@S{#-d8n%}Yu@:޸BzN ${V{]$ qXLY 5){CL>i?nwIE+@Ϻ0=)uD4"|Fvp^7aHg_Z,v{6I'hhn n&=^[i}AQ5 .B=:7ƒ߿Xܔ_y{H;ɴ`~˟,+  +7(v˱Q$9,}4@~}OjfC(&m$MZfEhXc !0 oƟBgAn>eiu@o {x颵8u+ӭn]+.WJg4oq V [gyU 骵a0r/'Rrڈ]ezg*7 {|(#s LE䋇ub?|$KʊJIPqi=sT9:%Ā{#RR]j#|ηRYD& ]SG-y'L+( 9aJrK_+Bu+҄~խ6qvó#0/W0}>ſH_m5b;pTcO,(o{ϡqʸGM Iè(O#Dć 奩yZuO&ޛW׵+puntj$EŠ,DC1AB=r%9ř^Y o)R 6 9E>AE%%:nzgoK#!,I7C"p#pQGmM½nk1_2r[:($c6{܄zԜ\y (zic¾7k5Xe4yϔy.1 jEP2Fj}EGk#:Ɂ/5rp bMKٌ'-YIDZ1W7nxկ{G.I 8VA(N߬O7NTĞ8s%zhTTʂ:/Qw4~DV6M;\Q vdrDw~3 {E<x5xٽKYch($ Ro&$XIdokh*"k:S3$YϷL p|9 w,#"uEBr,g drK$V؈~N#Z19abZKu# -TDyz8r^̢Qlfc߹~~H\r^71KVyOX?>q*5s (y@"$x֖蚂T'E\nfz8ڔ 0)v&|7B9YZf)@aL(P2'jUB%^Q[pWOt|M/{K|h! $aq~hEՔ:[X&x&+QSP4~ sSJ5/蹪.Cb~ɜ8Qd.Hh'-WiEr*KҒi;c3|ςoIbs'zhdzhT#s#(s㝢@JhAIU,G}ކo3qs5 'sK\d>ȏK()0'L\M)DVf 0U3g(?u*n`aU?odIUkxkrO:rƄhܡ;6CJc#]B6oشxʫG/i$F#_{GCb $]C9?d,g rHFnRdfgeL|AV986mZ_7r?ؽɏ*)f%n6,li۴# E.\H%xsq6|44t߻ GM. wM&Wӎvni&Z`lh޷C-r`vЙ1<9/Du?Sܫx4L>{w6 zyz0 BVV;x>n(ltG&(6-VÞmx[Tr_EQn+ dkr`\;7{)8|̈́~uM;( hUX:NH2Q4K8AO0tJ{L+Qq{X"Z$ k%Cf=py`GԠTh#tF̑Jܥ,vCW+J w lC\ԨS͉/?m{oӁ,/yۦp-'u~X)P U$[Ȟ3-~v@hǼa4)7 {չ2[3'|ߚtNp7V5WjY*>CO!FE&>>0N*c5qVQ^ڷSol*Nd5h?tYH6'Dv|+*Z+;/yaJޗ|$DSv^ڜişjzSO4Vvq]DuBhiօ'VS;H_}xxIגeeN>3ӿ.Wq;ɔ2nU5B+.%k4HZ/]OqMե~|[ 7S'n6:3.7zo0 ə{UyV s~CLaKYu:^ F%w̌kߪ|65-Rc:0el+M"kub'nE'z,hǽ,|3ӏp D,H?'PX2<gP%ئ'[ӡ9Q.a sK\*TyOGiS5g[;שn»@qgѾ*8_QNVa!}J+ĭD휵"jd EXա*0yەa. nmc<+D4B*1جWzumv7B3wЦNӻͺ:TN nXp'X5\41 a]}N\"ȶ~n]MS{ _s8$01Ne4TF"Ej.$`*-d}jSۤfc@nv3,9`\B\ç\LPq޸\k(\(~jNp<T[ \263RZP_ o{eS)+=[RS{[xNM {}EUϕ ؓ^ n-k6;t-J G‚i bQPDqf@BFDthii>N#Z)C[}iΏ_U;2^/% F/P`Ӻ-Y?<"SwϚRaadǰNyhG"z,;r͚I>!?dmNWU+Lam󂂛Ny3.>k6ĵoj#_mb dgUPQJDvXJ#1X.t_(Wv0B.N`ظjzqrYʨPKFϒH39S#hayˁ͍4Ogk䥩 U;|1 t?aBoWkgʿxGdEW^aYǂRd%xD=(Cen,]H.XCL>ȅjhŜRUgԚ3 ;N]r;k6۫GjXC' 4_Z(UBǨRoQRd6RCΪ~ ȅD[G1pŸ3# _>^)ja_0ؙ&r6[ [-L_b0F # j/?W) 2h:0|Y46&x2Dq𬺂;+ c(s ^b披0? x$Gu;G18ZEj8֪KTonou`m718RՙY5T4 o2v';\mULfůa$,:ޢhv!eáXqEٷ]lG,|U/پ^uAsmF43)t0`(ȼ=ɦ_=4'2PґŧN2Ljma;$Ap&|לiKKfo_mI)DbwWVN*/Scd|ˬe|7^OT7,&aE!?ȝhԯ]/=(U^zRX@"Jc^tӗ/+1@e{ ibOXK2$;>DAE(vKA(X}]=Fy&42⤦_7D:$͎!:; X9N7zmoȿi%}ΠWgo˃֙}9ݗVGFx\?!v]a8Ca g |"p2,nǴ6("]k HhD(y'b".^0נS~T ,-k4}^~%/xQKiWhBw "5"\4e&}!ef߫[.GVǶr~b*/ڭ1z%pu*QV7t; w[1$IyJ#buX/;"ƚx[&*k1~iw̼<ty`Ӳ2RX7wX^hHTl6VM *^kȆ}`MJXx/0%om#D GHɴbO hppčd?:Kmo'MwxftM?*BVs.1+'reܝGLj6NHJ`aD]murQD5n\N`O*n88%h6=K;?L;|*I.zњ˾V4 uy_wn#aN2ip]e0Gl̢N,le/ : ư0uQ!-{q~hx; )g<%"Sҥ <}ki|pg]jg!,4t.*>.yXI!IB6',lfbTo~9V[(͌U4q ~Fɠ˥Jo #1D͖̋` [m;8yL`TV|<(p XS1[ĴsSyVֈ3=}z@Ax ˁdDsj:WR:[6%2>јa(z.ײJnқwEԀ]r dK|Q#z ٭xe0i0Ñ'krlgmI]ylbPawVS4Xgߪ\C=b_+Np;]xlc `Z.\K+R)P!LuMFܵAgtKW[ <]FOs&oޛ@x|u9@z/p* bjcૉ\Kw휄œ,K9tdDY`Yq)V-1{7hocφ\*-ɧX  OH dC $z=F%^W]|Z@QJͫ853: ~K,tKI,B ۗRW?й*&sm:f+rC겼;Ga>1^qU4BKÈV& #&nҔ PB[[HT1&q*[fv1(´ g&@%b& i3>3 HPnaA-&Cj`d,c_v:qw*Aи&AMs|1vnDFqs;X1dYjG>J~yGFQ{l9RˆKOoFLN'0X~e3 (*]6|D6Ӕ f=7ɧߴ~w}UpD/1dzdr\S 0Ss^R3aUO(1Rs=$(Ko7hPVȃG'y\ w\\\z /ϗC Z25t$9~FF9CGu-iVKq#W+O:Լ뱹;~Q%.i%?NwrO[à+?j_{WJ5")yyż|,KU`ݴ^KF;n5}_^ӸxM,%]"TdBK @x +o݀k;z(A\\t+C9CצI{b&\Jt؝|raˆ^^嚄ک%*p#u4/Yg#o:lI:_Ѱ ɻ6}MvKU?3ffRWTnGaϟ8ܥܐg^|eO>U?rt'LC.y,\1^Ĥ>’~zxy]mU`hFHfaoL|6ԟ|8E~Hвrfk-Ӯ"+`0gD^pxJ }B^w=4ώ.  w,/]l nM$l35fݨّ8eɖl=KAbŚHB$%> stream xڍT-; Cp$ 2 % 5w݃kGrνkfozW4T5ވAM@P ; @BIS ƁAC ـeǠyrpC!paO6I 쉨lvv^66P$lPbC! G  ϿzS;??/p-l 0Kӎ@ W z!KNŅhua`au#d2@h 5 %/t 6`S) br<АS؁ "0>; ;'hj B 9PVd˜@o"tm&O?bjSh98m~;1KA$ w}`ӹ} _ 13݆ldf8 {Ԓnv?NӿJv[s)C #t}6n6ӧw"i'?~?l7IN)P>ڠFW dv_ 4 b'EabavT0S˿T]ـ! U# ?!3~zEzW b 5=l< 鮟7i*@ `e@aO!Pߦ?o ~;'? ߐ)#jd|wnMF,_;L1fVUMb/\lspaioH:oI:k QXoCfm.@<[ӄln9/|ıڪg 1 >rv9dꮌײR#T,X$||Xbeb-rԎo^JJ^+b&öS8OC`< ";o @o8!Z0MncTt#BNl bwJ4 W5CAVɂoa tE2]3c?X)x*Vj:&'2ԩjyL;Dś_åGZM-*r:qd1i^ᄝR{C3r8($JemcmÏe݇<$4ɀNtiɄtMatW쀈7o I,낽`o=Hi Gu/ҌC0= B!$w?)6iI/*c0F2# Mߖ$xTtx-kVuU;_PWOT>bd}nV-Ftnq)`` ; nt=;up9 x_:O# 8V~ύT /n%rՌ-;j]2\d(lzû:d#Uf!e:Zd,@J^ިJ۲=8 Vy ϻn_~F1ĘT,-˻{Ҷl3]_Tv+nHㆩR }[V, a;2 ,\a ?<` ư\f*}r3su Oޢb|~ui<#ud\ߑĞQx& {l<h+g?X} -κ>q \ ߆,AF 䈗i,eˡkW4 ~ qrP^ #{P;rQXVCo|k(#FUN3D5fy(XuFɨ##a0,$E x oY^J^19e Y- SϭbF}m4+}jPVW[ r̘1k8aX⅚m *Ly%u.$ uoQS*~&_.G Í*:MMd,AgHLx;^Np~Ijfl7?J}TR]fEfUH9s6sp3`aGHǶ _  `Ѷӳ#d9E\UH(pRGT@(DTM l=+_~`4l}a"l}滟W\zl<^SlW,67;=(Zt{VK,qrg7iP?* 4  ]69*Y'&&> LD))Kxj~HTBEi(kXK6&Z!6AV< 75$ZwrYB㬋U1-YIQp. (2(4Y -מG=|!^kYχL&6\=ICW ^syu=w߾t}:YEQ_hhw>,1gQIw֎6&K#|U}F4? EhiPR/*i߼kָkEfZjI +zViRƗE rα/y|3%38O w}ZZB7D >v7S_iu#'s35#j c>\N~9(rk_!sM^!.Zǚ _7~OS?O» _1Lei?jߏ}v"f4FD%S^G(ƈ1{$yS+Ñ;1ME, ~:M%c~e֪| ";gMM8_VV}lIa3K =^Ozl/`+\=-BOkyBnfweft(Ӟ8:MC{ iaQW)3p+7M 55E#Sq<\h.NLT˵l[1ݟ_`LEuV+?;m3{"ա;|"p8j:NCyۯP6!W/"3H<7zֈ.;upyGK/ڑՏOJd{d{FͱPP'Ù7c]NƋӝsd.&͒#IP(nȂ*xF=wnWڴ :@7hN0@2op7AU`3ƞ kf%șѽ37YXdT (G,mFR./=|$$L*đ`|YN=s!N)%CiE9Veޭ4)gni9%gœg@Q.I|]?_D}oE|q|4jZjPD@c⤔n#2 a8(L$H30cXEweeXT"Z\yA"īexI 4BWY+cG )Kְۙ-,>ܧ\:poL5}<8ʝM :KI_0ʶ I&rJ6d谍{|6B^AOEԕNDz`#ن0#V̦2u4"&"Əwe$&<6G3&_p?}l\\%Rƺ06Y{c©զVA*I~}ZMs"E6H騁#0qfYêK$t9̘fiz~x۳Xe#3[DF\2OE悄%d&iݞ4?Cڐ_zsDJS=0 YV%z[L'"WK}N]ڞs/͡\0ץ26ys5Ħ~+^-,zy +8Y”{gP8{/q!-8"LZ"h}6dH4 +dy77 F[iݵc\ޥ#Jx7iء6ctX"YGk2 A>/&w:"9Pӛm»ӭ㕙BI]WzDuU;V>H2<[dQtВoKpP'')1y? h~G/#y9Ϩ+(!b~4\%+&=Z#CnŋQq "s%MU%U̞KT̅۔% q( Krىi4,޽!ˇ6iø |"O  0h3:1~ymfR X]x()Q8;GXArJ#~kLqYް*]Jf"$4AmrK$@tg˙]h>rڙ2,S'_m/د/}F;?uy:N`ݢTk]LcEgIА^vƉxȿg/*IH^%%MPҲ8_bviF&&xCLPl Z99;:2.eq4!0F-Iۙ) Ru7Iڥ٘-b[/t .ZAZ|m~~V GF$1W+9Ь #N|Lda6ʺ'{͡&I~F|ڟ _F^UFRHrň`7%F :5<샊yM J/1 H09&UL5`QTe XU;.Zx%ۜZ/&88Si k~Ewnd*^ Ns -HpVnz ޴%U7H˝ ԝ-d<-VfՌQťHJ'NfK|]*5\oo/.0 1@ rؗCT"b ^0Lg;buMwJLΠHk3/gp)_O-|-XR 4^}ƲA,03BSB(}~#f*,9V0+x1fy\C ǜq@m딦]4wˣ qO`/I-׿B` Bi19=p'gk|r:g?]BtjʚK1<~d$1fWrHl 4.Xwj : .CpVV*G{y ^Y"9~/qع3_"BJbSg%; .¤pw|CIQ<ŗUU> {/S  ǁd57|l 2ޖӇ_o8*\wOg2R3-wOVd+7rcoy>Z ESol"ɅVS6fuíJp3[UWdTǂ[7n\ htrY>FRMZ08>F*Ƹj8Gm-<|72y#_g46݊ZJZjŞ-WqD!N05屼pg[Isbb ] Y.e74 \ğU8V" Mg[>Aɷf!F5`,= `m77q]pt50 _*aHkc*%Z( |BM(~I[⵼D4窖t1Xv\ : RBRMCnl{@[̲M~[lN5~jW(7Rx&'˰z|ٮ K#<y pRDX3:YDk;aŔ7afw^ 1wv=( ?E@~ [vrzѤ4O]ۺz4AO$qMG2&;x[x:_|ƻbJEIc=㝴/Amdwxn!?9rZu67no?)al.Tī Y,_Wj4*~Y֖x!7Ҋj&["k8P0Vl8-F0ZdωqW~{jQ)2iHwIk((Nj'lq^d%RcݺApB[45׹g)d}/><LU<Ճt=(dWg:h{nT}(JR.gV ݾHcq("~nTMX ڄ/=#z+t0G0:Ɇ\inv`E}H^-i4Jj#Jܤ*[X֏-xFΐ\74es$ 茘1"!e>WXeR͚G=['lb1~2ltʕ<\l)P2s5{M֟}PyNò*%w< e{4hFʅ wSm&D9_Qu7DWDvXG`Ukj!%}7]I8k9:[ݑV: L&uJ7.q7BEpG 뜂voNsXZX{vRq>)i0Y)_-Fblٍ_uD$jٳ3'r՞;1t!lZ 30 󾻊tMzk5,q(7ys]oҮyw؉kfz:5D[[/q yd! endstream endobj 96 0 obj << /Length1 2094 /Length2 14116 /Length3 0 /Length 15388 /Filter /FlateDecode >> stream xڍP ,%{p݃k  \vϞ=W[SP*2M`;gFV&>+ R lRBh&7v~3Td]lV.>Vn>  |qcW@ :!R=Aoy@cJ `f b t-oMm`SBX:;131:1-in gK 4Ahl "%@*x؀LvNo..vf@G[v<@hc0jpyd)dg0JL c;? moƮ c7?K7H|1#ى dG?¼YL lk svB>q#=dgf 3{fu; PF/7?2 3 tM-HaS=`F2}!z9Ύ.@+!@ob;,o `/ 3xc3+j*Eo(`dcgpsx>EW3xS[[_@z7"mn\aߌuoE.66ic7xe6.o;~k *@.W+l "v67$ r)M-3PYYXmL߮Hf3dl\cGGcDIbxm!03ف\o|`G?,?,0K 7Kſ3qAcԬovt͝-xxo]b6s!Ϳ- 3ofC6mqy+.fb/FoUK{˷ś /֤h|_|9k6ҿ1?rQvnֿl7".`gɿc}<]E~xΖDg7( u_ۿ&-?l= ?b{I{݁+`S`j7ƽɏs{^+.ɴU"#hw%hnWI~{Ç&~j{~6WkC\*8 zGȨ&[#K2U9ޭ_ʽntm^:[l1 jlN:xD73T^_dqJ6?.e2Alxuӕeq\icC~jdOWkGo&)\o?.ܑL5^k{FFg픮種;M|t{Xe|곚:swW,8sAE/HN{YM9Sɡ^ qT'O77"N&+:Pi #r5|²kf3m aw=Of'O"`u57hF(`EHsj3  $BHLMRD r.ݢDڼ)\Q"GydJWB%M[89oJwt W}Suzt=F݇jj4u 20Zx B}|:7fo OF笎I4GŎ)4ѹ6/kW` ~Gar,7b.;>ʯ\i=5t_"1R-7miskJ?nqSo[eD_SVF$|epB qԸE+<))F0ǬEI҃Bj}jn$\H9Deڋs#T8r?uDsBJ/p\螢iw}I֮<=;2e5?>SWZDI ?`Q@99$3_Y`7ژo3Nq0 Rzs>gdrN\4YqP_Spv0i!gԘ!?zhYM-VN3GczDU]_n@:>|#L6kmSGX5DJ#SB`<>&SЄo^#2 ڑW".{˗`t6O'!TVybzUUN#29Z:/ӱ@8W +b`$~ϫܨ}}b?J .?Q-VⰙ[R0'sS4uEe肭AM*y ; ZJLCAijg1;&Wj6GuW^ymxU-#0Cs`ΗXLs^rnK&aQws)g&7M40C;BQykk/x^s gH#2vYbHʛ\Wq0>\^zItIEYH.]F53F i*~*`)FR^T:%NKC!`/,iyƱẼn$ⶲ7\85) DBk@zvnRpQ`7<h lZv~Str!\'s\>[֯>^5Hԏ쪎M0%vUŰn"=D_M+bt4\@v$?&@3$ e|M 5͞~^&5~*h7 gYN5 J*ķe Ǚo Ge."8B 뙞 nZҦ<"C[1> *sx xr7\7r\àr> DA9=Èŏ]m1DG@aU=V5MqbD[[q3ӏs֕t?-)Sf~aea%hDÇسs^I5 BY`UKǯ\ӝa aT1c \r;Q,] Ya'@ˣI4,Ѽ y?CwD@Xl攇!iؖ^);ۜE͛b@F8yRw Mkԗ r#*t(KvX( S݄c׌9=\!uG4ɹ;Xֽ.gixNpm WkeU;Q {Oxswނ]`,IKU Z:ثN% N4R"iKS\l^jk\eԟv3#gT$0)ԃJxbn4=XQ$`a}ϩ]%71@uR Q8sAi+;1Nk丵˾߹gh>6I{U]J2-S^q0fx($ܲ3Ksw_Rg o91i(3V6A XFdɭ/$ؕ FQ jT)c($,9e9(8 HKzVx~yʑϐ* 6l.kG;R/kJU`#@}_lZ84E;? [\ulk$דIBo:!{F^~\=Y,NAt6**7plJfUvCIn3`P+Y|Ntd pĩGK;V2zі #~c0TY(Q`<VT~'z afQ_ lKor'Mf}"HrN\b㧾)7(rx/0Es~)Ս A334@" 1|gBoSFE 6tuPZ E3rXjiޖ[8spNMB S@= n@8CܝH깊8 5HNS r/ e(yR)WK՘+14C4혷Jz:Iwֻ۱Zꁒ/JQ`Bʠη]_ngcgKQ;D|,9Kȼ8e5}%Ak09z^-}~+ٙ7HrA?OM"XB *:%L&~!x7`R "AHdwO[ؽE=%9n5U GSeh}_(3MtЕ.U6[$*8Ȳ4*e΢"~9E{}u {  bwR`Rp7&=yL8b{7 NP(5uČF eG25UU_B }c%Iq#Ő:`#u\;*DkvK+)hG wd( NÂK+\S@)QAXj{< E@+(b;OsKV5ÂW^p\Y }DTF)ja cxؐKNՆ»tw`сb+). c rkT24fr*TA]e~MK=n(7RaOLWʤY2tIU}OOE՜I 2/8 I2gafgTi2!5FS6QtH vf >S*.i&MB ֜:~:’캠YPh_͟R ' h9婻#Pt~aҕT beːٷQ7-X]',D{ǫt: _Q?~{Y_-Y GFn4ZV$qTP+WsB% n+=淝h\?cTg|W39:?Ffrdc7JW)\?a>R<4f7|/ʦޑ3*e/ 4gCTLhcWBu%5f070xK#oc-[Cw|)0丄,gdqhtG@Mq_aH_!x62MFS)qLҾ C-V&x /8^nqʮ iش4ZPVCP0X/ow殯"-QzOy ')`𗳐卶Ҭc6[daf<6x Nuqvp\yϹJw 9Pxj4ُ"d"NoJ鸌j%g$V P4nVQlW iL: H^ڌn !GsQAƴ/sqTh^plȗ{rɸZR;%,B8݇el9 '3_&z#_Nn}?8 qNVyϦk 7%~J3=|#r9]୺Uݯ+/KC+`ڪ0 F@^V*/KyvدP&-CD*ܫ?i@~fޓ3l <ɗ ?@qP`԰h_{AĹ"rG̷Z*yӈh#̢Xw+,ӺݬU =,ﳾCR-]xȁp_WN /QRx`/^ PXiEShI{i OV܃okɵKI~H64 Rn$u(ۨ<#bc\}pXٷV#s͟Vh] (~?dfG/ݔS:thyDCp2D0ᒷjE5i!tMujJ<7ڋ:uSdwnfyf^!e;Z3/&x'`d?> b*ѵvUqך |:/$ gX.N hM,7{f+- u+ؤ2V\$ MI^ A^;/(#1Čt>Q´Ŗ@DXTR{v 32eX/#o҆Nnr/^L1ەEEiȼ:=i)9F7Xiẽ|Y8Mh?VΫp Y"*ՓN{\;Zi],9 XC^?PKo|WwTG7c^:#L ld65D \OF !M +bm{?Tiɝ|~ԆJ)P,QM тg" /ɅIu5~t@YF x4c}.?kCwe$1ژ싳#˪ܵnE P ;,.Yr$-X0-wK],~Gyq%e4es2 )ZICIz8=Qߨf¬ZԂY\ykX i_G5tLyʵ3Y &BC#<{dmpBr!x#FgbOB{@ S%nB0ɦcJ> Vk:Ct3s5k0m(k U鑫Ϥ_U*֗ZW5I`­EM9@ARz|)0Up 0ޢGq>yw:_JCe6Djgr%sgAnq?7Jz]3/)$Yɭ:~|H%Z,QXY>:ɀl=9dK>-)}Sv)n|+6J B^hduB->rloxMuqcuO$;ҿP-]1@ CAe)el$P5V5ݡjBF~ w/Ixye'z]xr+1dVtbL5-+@ RaV><wC04?W}ިdv<1K5WodLB-Gmz_E*/ܬvTqar|mTtBXR!юK!!l!6^M,`\Oby-n1~ꆹ;{!* C))0) )X)M_[16¥+tn1l`gqLD{tMfXtM(%uR&x?neireL¦ 0P+:H fSQ|xmOdl<Ĥ*6y]=?+Մf({W l[<$84ڔA;+֏_Z^IJe^lQb|\~5]00C̬Y@R."rfR="a c8g {#a&;ŠMtZaF'y8¢զ1]ޭ"?yh7+Y'yq83OFݎ]7F4<عN! W\3tp +ojJ#ȫI`:6v< Y4js)ce:VC8Dˎ rr|j>4 f`ZEC[~XlB-ۦ 1h'%e?8`D)i)4\ Sԧܱ>qwHyX:uI m AUF 8Gw6 ̈́9ns7֙ 9Ҁ wây~WΡ.ʰsv_T# ́ U*3k7t ͪfdD|^\άXh>yJو&Xu0RM š 0б~3 sg{\bn4P+4S"(EFyaS*q3uHu9Qږr*i68 x?:n .i3m7 D~'key]ʽ~rЁ"oʀ#*tlUr &}ȌnmWR$)/~Í*sS>#i+9l7 ϨwW'i#OyyT=6ck>"L~Sx+ǪMTcXc)I xj0\dϛbf;E )c]_45ɬu]퓹ݢ,=+%ɉD3+M%X0'M^&3*~ټh-Ηf]{/w>5WScOZ(1Q z?E} ħt? {^+w#xWk9ɇ̨YzN *D̾8E%2ZZFTNѿbO2uƾY q~,4u^FNlHFkĞ235$j%Sa٠O%)+KBPg5/ "M{@ɲe2,3/-vY( 2f!o~OgkbX1ۖYW@4FשsJO; ZYwl)58X Ƶ k@wĤ M2exPF.l6pE+ψK0`w;)\0aiJ6jMFd.ͯsY 0^GX Wt TF'&ˠ8V >bƫthM1ERנ}S)Ԏ!f̤A>~| =.bL[} ?Y􄇒*bNX9)|8w='^4q":~<V+7aKlL0t쐐;B]vj;N -$;5cBgM+tڟE@T6uwKYW;" rD=&H +,UHUQ<颋rܧ x|-q ?%*|.|i!VK]:5ҷ @Z(6Ǽ5u)KtAXYk~mImr턜q'gtG?`V UoУkMɼe縤|wS{f=X8U0{`YM%Wq4i{.N9=<⎍zc$R.exeG' \JM%3~|;)2eݬ11HKs;AW=e헟;;XMܽa&K=w(*>GS}ŭN,Z?fC1ԓ|贯.!K#W ĞeF,\; q22lI jK#^0n 謿w"ZѠ}{I\DMX٤L[cO|zpk $l e8e#z{_ ?1O(pwKzɀ@ nYjjqӱHX4 # Fଦ2E CX7?Qr *:}ƃcJ8<#C~z x☢ ܩn)BG,ԛQ_z9-㖑NdU׶9[.*8DD4fS-EFΘo5 FTKUm| L*=}HiY MB5(c XйjA\{BZR; cV+-:x(w)`Ĩ[x 4o>z2 OG }E(c67+'N32%ϯpC8ػ̹&S׾(7e*k̋ x˳U33&ȗņHp̫e (K KLlDm [\{ӠBa{9_f8{**^w/B(leL`Dsd%SJlϔ^rqd7WgmS,@nid"ЖĪ/^𣤣n&Z(\ʨaEz'X.wD>U"f]TaC>?X?I-"/5Y!QF9!&;<E9IZ޴ &*4&.*VkDwCbʃaP[V'9`"z20ʛp&Ƭ,Q~K""ut{kAaJgӞ߸,(6rb##y=(ߡo([0|LF V22rQO4 fwayz5,O3b7Q@yn}wQ{H;bdZ.,kW}+7ͽyxF1  A@m_F?ԝ];c%Pp2ahDƎkIua|zcE@zN.oqXB^?&^6)%= /HʖhsBJ\]yr &zRrxF-. ~,uiy#sh_)R}˖m-":Ë?ߝ$?)bǻgI q'WR8jHcJt.o5Dz%y [5R\sҞ\ ? ѮU$ΥPՂ` &/*U#:ٓ, &n܉vڇ;2CG1u.*KOw=xJkOnrQ۫@ Ō~Vg.ˬ>ljpa\(&c6 ёpUA>Px|Yl K=i D +jI NaZ5HPqYo9/G)X3,svhIa!uos#i293zYDf|e;2,k93 זL*eJ@ٕ>/zaU)r5c9}x֖E3y" e}Ql y&r#u١1d`c _ 'stz2SzZHO'Gstl;6+-Z!ڙ~Bu^EaALREV 鞯773;OX|t 1,jZ]<#_i5nsc&Q>R9?31 ~V b{)V\{W&1Af%P <>NvYX" p! u+J( g\!"(uwLZ1UDh|!Y"*/i`x!˧ʾ_59= P X)%spUhLe5dR4Q_J{ɞ8ZG,i8I߮e)ml1|%PLe]vo>mvґƌ ڎ%ɀT8 *78KЊ*/c M7˛,Wƿ ?X fk=b=%F E:ݗ-m۩_ayGmpxԓ:mKJaEVZ'|bcآЎalf7QKDg*sf"mj4p\%mldJIT!k:tSdP< F%UNv`XxL1Ǥ9xX Zp?@gt}h&o]){Ffn(+Z/ip> endobj 2 0 obj << /Type /ObjStm /N 88 /First 674 /Length 3142 /Filter /FlateDecode >> stream xZ[o8~cEL"R\I$EN)؊ced_!eY&nviZs!)ILE03lDĜbe„f"281~L@J&AcITHJ0hjHO0>L$X, V,J(I@ X̐5&; @8cG1F;;QX+!8)ႁzx!,d# ܀\MZRᯱpI)`'6bR;?B90 0NxHt*Z.p(qTPjNI L[+Ctq95@H00+s1dP < CDVABr T(4T0B}$\ 9b  N$W2'c= ! ل`p;GIN˗_2*?b/٨ʋP_~8Ue1^2O2vPUe~Mòpݦi2bN\k|UU>Ȭ哙kΚ?MwsFS{n1}DyuMR^2ߧlYͪ9CFp/y(Gٜ9yξD0;JpRz٬/T^HVwXf)yrV{qOId4ªX=(([Ǯj Lќ/E>'FP *ko~),19yF4߲ͦ*z6*3 '_!Q-dI5c>;Q~{= *g9&,cQT4*h>.|I~x:B(/GiWttT3~SfK:!0|C*Ctzyh:8alP?" PCh1TZF1T0BaEmZmS`ے jCt~;aJNf3bz"؛qҟeگ"ӡQd ̺G m W0״xF1606iw|R;3TRnAzn,"v '1OD 5(P'fL8ЯIX6z[IaV͚mtybC #!#B V@ʻK.̱ 7b~ۄS9K[7qu7sGYmDHAbmVC6o: RgdƱ`= 54GC9=ANjM_r豘 uM  'Vo8pڏ%lVQS Q$0ޒZĶ+I3hi5HhQiz4Z誯C2&+AڸxyRm((\( WiCh,'=]DHnٺIPjTBkɰm?fE䚍|[0I(I4 4H#'L=^yZ2N1-$zhՂ j{;1+u(.uPrF9//5mE^=/4a3`SB[Y?|8|$ǹi ǖV?Dt>85oC&9]\FZq4]%P)SimP%) zJ%F[1Z$ crTS_Rsmhj+"*Q^C_4ǝLx'Z$눒ݖ6kԼc%ez m?z;7eQ?TE󛋷g8<}%"Oɜ a}k4Ԝ^>}x;&4xR|t0L3Uv+%f|:go ?<7|<|s>3^b̋1/W+W|L?Ρ0Sc@|@\l=zƵpPk~X\5bZpOkln?o XW vŒ?qVIP&_P.ÙUn 促ic y`HeiS?Ngeq;ʻmB.9*ݓݎQ76%KHޙ3.ϋϟ/(ﮮMIF :7 qnW]Wݓ͑84mNz|7e:U~0T"jͩ IJx]68N9x,.UfjIrNWɶ@_B̵}P$?)@ZT5 9qr}Krrkl=9NPJט4H-ߵ)Z,GB0:5Ͼ.b2!Tw7B'Pz0`"v[{m_7x[hwݽuۭ;~&rwݽŤۉnZ7cv׽^{U_[`E|=ߺ+nwbSn\ufbN&za ]ʪ~^9/)jļ J& ] /Length 259 /Filter /FlateDecode >> stream x%I2A! 3d f1CB 1.]D.[8J8*;<ͯnI @fgQ (Ap uzhQFh4\@! %hVshv3AtB)R~8؃}8#88.C7y?o L0H9_H4ŠM̘RO>7kJy-@a aVa aÔymWeM/c,x^( >= library("graph") mat <- matrix(c(0, 0, 1, 1, 0, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0), byrow=TRUE, ncol=4) rownames(mat) <- letters[1:4] colnames(mat) <- letters[1:4] @ <>= g1 <- graphAM(adjMat=mat) @ <>= if (require("Rgraphviz")) { gn = as(g1, "graphNEL") plot(gn, nodeAttrs=makeNodeAttrs(gn, shape="circle", fillcolor="orange")) } else { plot(1, 1, main="Rgraphviz required for this plot") } @ \myincfig{foo}{0.33\textwidth}{The graph \Robject{g1}.} \section{Edge Attributes} \subsection{Default edge attributes} All edges in a graph support the same set of attributes. The set of supported attributes can be defined and accessed using the \Rmethod{edgeDataDefaults} method. A new graph instance will not have any edge attributes defined. % <>= edgeDataDefaults(g1) @ When a new edge attribute is defined, a default value must be specified. Here we will define two edge attributes: \Rcode{weight} and \Rcode{code} and specify a default value for each one. <>= edgeDataDefaults(g1, "weight") <- 1 edgeDataDefaults(g1, "code") <- "plain" edgeDataDefaults(g1) @ The default value for a particular attribute can be obtained by specifying the attribute name in the call to \Rmethod{edgeDataDefaults}. <>= edgeDataDefaults(g1, "weight") @ \subsection{Getting edge attributes} Edge attributes are set and accessed using the \Rmethod{edgeData} method. Only attributes defined using \Rmethod{edgeDataDefaults} can be accessed using \Rmethod{edgeData}. If an attribute has not be set using \Rmethod{edgeData} for a given edge, then the default value is used. <>= edgeData(g1, from="a", to="d", attr="weight") edgeData(g1, from="a", attr="weight") edgeData(g1, to="a", attr="weight") allAttrsAllEdges <- edgeData(g1) weightAttrAllEdges <- edgeData(g1, attr="weight") @ \subsection{Setting edge attributes} Attributes are set using the replacement form of \Rmethod{edgeData}. This method allows the user to update the attribute for single edge, set the attributes for a collection of edges to a single value, and to set the attributes for a collection of edges to different values specified by a vector of values. <>= edgeData(g1, from="a", to="d", attr="weight") <- 2 edgeData(g1, from="a", attr="code") <- "fancy" edgeData(g1, from="a", attr="weight") edgeData(g1, from="a", attr="code") @ We can set the attributes for multiple edges to a single value. <>= f <- c("a", "b") t <- c("c", "c") edgeData(g1, from=f, to=t, attr="weight") <- 10 edgeData(g1, from=f, to=t, attr="weight") @ It is also possible to set multiple attributes to different values in a single call to \Rmethod{edgeData}. <>= edgeData(g1, from=f, to=t, attr="weight") <- c(11, 22) edgeData(g1, from=f, to=t, attr="weight") @ Finally, we can set the an attribute to a vector of values by packing it into a list: % <>= edgeData(g1, from="a", to="d", attr="code") <- list(1:10) edgeData(g1, from=f, to=t, attr="weight") <- mapply(c, f, t, "e", SIMPLIFY=FALSE) edgeData(g1, from="a", to="d", attr="code") edgeData(g1, from=f, to=t, attr="weight") @ \section{Node Attributes} \subsection{Default node attributes} Like edge attributes, all nodes in a graph support the same set of attributes. The supported set of attributes and their default values is accessed using the \Rmethod{nodeDataDefaults} method. The interface is similar to \Rmethod{edgeDataDefaults}. <>= nodeDataDefaults(g1) nodeDataDefaults(g1, attr="weight") <- 1 nodeDataDefaults(g1, attr="type") <- "vital" nodeDataDefaults(g1) nodeDataDefaults(g1, "weight") @ As with edge attributes, default values are required for each node attribute. The default value is used as the node attribute for all nodes in the graph that have not had their attribute value explicitly set. Attribute values can be any R object. \subsection{Getting and setting node attributes} Once a node attribute has been defined and given a default value using \Rmethod{nodeDataDefaults}, individual node attributes can be accessed using \Rmethod{nodeData}. <>= nodeData(g1, n="a") nodeData(g1, n="a", attr="weight") <- 100 nodeData(g1, n=c("a", "b"), attr="weight") nodeData(g1, n=c("a", "b"), attr="weight") <- 500 nodeData(g1, n=c("a", "b"), attr="weight") nodeData(g1, n=c("a", "b"), attr="weight") <- c(11, 22) nodeData(g1, n=c("a", "b"), attr="weight") @ <>= ## We need to reconcile this #g2 <- as(g1, "graphNEL") #edgeWeights(g2) @ \end{document} graph/inst/doc/GraphClass.R0000644000175000017500000000061614136072201015400 0ustar nileshnilesh### R code from vignette source 'GraphClass.Rnw' ################################################### ### code chunk number 1: graphClassDef ################################################### library("graph") getClass("graph") ################################################### ### code chunk number 2: multiGraphDef ################################################### getClass("multiGraph") graph/inst/doc/GraphClass.Rnw0000644000175000017500000002714114136046755015766 0ustar nileshnilesh% % NOTE -- ONLY EDIT GraphClass.Rnw!!! % GraphClass.tex file will get overwritten. % %\VignetteIndexEntry{Graph Design} %\VignetteDepends{graph} %\VignetteKeywords{Graph} %\VignettePackage{graph} \documentclass{article} \usepackage{hyperref} \textwidth=6.2in \textheight=8.5in %\parskip=.3cm \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Rmethod}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \newcommand{\Rclass}[1]{{\textit{#1}}} \newcommand{\classdef}[1]{% {\em #1} } \begin{document} \section{Introduction} The purpose of this document is to describe the implementation the classes used to represent graphs in the \Rpackage{graph} package and to discuss design issues for future development. There are many different ways to represent a graph and to deal with the edges and nodes within that graph. Below we discuss the graph representations implemented in the \Rpackage{graph} package and define the set of methods that form the \textit{graph interface} as determined empiracally by the methods used by packages like \Rpackage{RBGL} when interacting with \Robject{graph} objects. A graph is a pair of sets, $G=(V,E)$ where $V$ is the set of nodes and $E$ is the set of edges, which are determined by relationships that exist between the nodes. If we let $n = |V|$, be the number of nodes then, excluding self-loops there are at most $n$ choose 2 edges in $G$. A \textit{simple graph} is a graph with at most one edge between any pair of nodes and no self-loops. \section{The \Rclass{graph} class} The \Rclass{graph} class and its subclasses support simple graphs as well as graphs with at most one self-loop on any given node. Not all graph representations can easily support more general graphs. Limiting to simple graphs with self-loops allows for reversible conversions between different graph representations. Furthermore, this limitation simplifies the interface of edge related methods which would otherwise have to support ways of identifying one of many edges between the same pair of nodes. Arbitrary attributes can be associated with a graph, with a node, or with an edge. For both nodes and edges if one edge or node has a particular attribute then all nodes and edges must have that attribute. Nodes and edges can have more than one attribute associated with them. \textit{This raises the question of whether we should use the \Rclass{AnnotatedDataFrame} class from Biobase here as a way to implement general node and edge attributes.} \textit{However, currently AnnotatedDataFrame is based on a data.frame and cannot easily support arbitrary attributes. Even having a vector of length greater than one as the value of an attribute could cause problems.} The \Rclass{graph} class itself is VIRTUAL and has the following definition: <>= library("graph") getClass("graph") @ The \Robject{edgemode} slot indicates whether the graph is \textit{directed} or \textit{undirected}. Since some graph algorithms only make sense in a directed graph, the edgemode is a property of the entire graph, rather than a property of an edge. The \Robject{graphData} slot was recently added to hold arbitrary attributes for the graph. Although edgemode is such an attribute, it isn't clear whether it should move inside the generic container since edgemode is of such high semantic importance. It probably doesn't matter as long as methods such as \Rfunction{isDirected} do the right thing. The \Robject{edgeData} and \Robject{nodeData} slots store the attributes for the edges and nodes of the graph, respectively. There are currently implementations for the \Rclass{graphNEL} class, where nodes are a vector and edges are a list, each element of the list correspondes to one node and the values are nodes corresponding to the out-edges from that node. If the graph is directed then all edges essentially appear twice. The \Rclass{graphAM} class, which stores the edge information in an adjacency matrix. The matrix must be square and the row names must match the column names. If the graph is undirected then the matrix must also be symmetric. There are two specialized classes, \Rclass{distGraph} which takes a distance matrix directly and has special thresholding capabilities. It is not clear whether this should be a specialization of the \Rclass{graphAM} class or not. The second specialized class is a \Rclass{clusterGraph} which can be used to represent the output of a clustering algorithm as a graph. Samples represent nodes and all samples in the same cluster have edges, while samples in distinct clusters do not. Instances of this class must have their edgemode as \texttt{undirected}, if the edgemode is reset then coercion to some other mode of graph is needed. \subsection{Methods of graphs} Here are some of the methods that all graph-like objects should support: \begin{description} \item[nodes(object)] Return a character vector of the node labels. The order is not defined. \item[nodes<-(object)] Return a new graph object with the node labels set as specified by a character vector. This is slightly fragile since here order does matter, but the order can only really be determined by first calling \Rfunction{nodes}. by providing a character vector of the appropriate length. \item[addNode(node, object, edges)] Return a new graph object with additional nodes and (optionally) edges. The methods that have been implemented expect \Robject{node} to be the node labels of the new nodes specified as a character vector. Optional edges can be specified. \item[removeNode(node, object)] Return a new graph object with nodes (and their incident edges) removed. Current methods are implemented for \Robject{node} being a character vector of node labels to remove. \item[edges(object, which)] Return a list with an element for each node in the graph. The names of the list are the node labels. Each element is a character vector giving the node labels of the nodes which the given element shares an edge with. For undirected graphs, reciprocal edges should be included. This representation is very similar to the NEL edgeL structure. \item[edgeWeights(object, index)] \item[addEdge(from, to, graph, weights)] Return a new graph object with additional edges. \item[removeEdge(from, to, graph)] Return a new graph object with the specified edges removed. \item[numNodes(object)] Return a count of the nodes in the graph. \item[numEdges(object)] Return a count of the edges in the graph. \item[isDirected(object)] Return TRUE if the graph is directed and false otherwise. \item[acc(object, index)] See man page. \item[adj(object, index)] See man page. \item[nodeData] Access to node attributes. See man page. \item[edgeData] Access to edge attributes. See man page. \end{description} \subsection{Some Details} Once both nodes and edges are instances of classes they will be quite large. In order to reduce the storage requirements (especially for large graphs) using integer indices may be beneficial. The minimum amount of storage required is $|V|+|E|$. If we use an incidence matrix representation then the storage is $|V|^2$. If we use a node and edge list representation then the storage requirements are $|V|+2|E|$. When either $|V|$ or $|E|$ are large these mechanisms will not be especially efficient. In some cases it may be better to keep the actual node and edge data stored in hash tables and keep other integer vectors available for accessing the necessary components. \subsubsection{Representation of Edges} \label{sec:edgerep} We have taken the approach of allowing the representation of the edge sets to not contain every node. When the graphs are sparse this can be a fairly large savings in space, but it means that one cannot determine the nodes in a graph from the edges in the graph. Also, for the \Rclass{graphNEL} class we do not store the names of the nodes in the NEL, but rather indexes into a the node vector. This is important for allowing us to perform permutations on the nodes of a graph, but causes a number of problems when subsetting graphs, and means that knowledge of the edges does not provide knowledge of the nodes. \section{Multi-graphs} There are no clear and widely used definitions for multi-graphs, so here we will make clear a definition that we believe will be useful for biological computations. We define a multi-graph to consist of two components, one a set of nodes and the second a list of edge sets. Each edge set corresponds to a potentially different set of relationships between the nodes (which are common to all edge sets). We denote this by $G=(V, E_L)$, where $V$ is the set of nodes and $E_L = (E_1, \ldots, E_L)$ is a collection of $L$ edge sets. Each with a potentially distinct set of relationships. The edge sets are essentially identical to the edge sets for a graph, and hence can have arbitrary attributes associated with them, the edges can be either \textit{directed} or \textit{undirected} and self-loops are allowed. It is not clear whether there should be distinct types of multigraphs as there are graphs. It will surely be more flexible to support a list of edge sets, and to allow these to have different structures. Current definition does not extend the \Rclass{graph} class. The definition is: <>= getClass("multiGraph") @ \begin{description} \item[nodes] A vector of node identifiers. %% FIXME: if these are node identifiers, then shouldn't we use %% "character"? Elsewhere, there seems to be an assumption that %% node labels or identifiers are character. \item[edgeL] A possibly named list of instances of the \Rclass{edgeSet} class. \end{description} The \Rclass{edgeSet} class is a virtual class with several different extensions. These include a \Rclass{edgeSetNEL} and an \Rclass{edgeSetAM}, others will be added once the interface stabilizes. Edge attributes are in the edgeData slot in the edgeSet class. This implies that edgeSets in a multiGraph can have completely unrelated edge attributes. Another approach would be to maintain a list conforming to the edgeSet list containing edge attributes that would enforce the same attributes to be defined for all edges in the multiGraph. \subsection{Methods} In some ways it would be most natural to have \Robject{edges} methods for the \Rclass{edgeSet} class the issues raised in Section~\ref{sec:edgerep} seem to preclude this and it only seems to make sense to have \Robject{node} and \Robject{edges} methods for the \Rclass{multiGraph} class. It will probably make sense to be able to name the edgeSets within a multiGraph and to be able to extract graph objects from the multiGraph representing any of the edgeSets. There should be methods to produce graph objects based on intersection, union, and more complex combination algorithms. The edgeSets may represent interaction data with reliability estimates as edge weights. The user may want to produce a graph object combining the available data to obtain most reliable edges. We may want to consider apply type operations to apply an operation across all edgeSets in a multiGraph. \subsection{Use Cases} An important motivator for the \Rclass{multiGraph} class is the representation of data from protein interaction experiments. Our goal is to represent these data in terms of what interactions were tested, and of those which ones are either positive or negative. \section{Bipartite Graphs} A bipartite graph graph is a graph where the nodes can be divided into two sets, say $V_1$ and $V_2$, such that all edges are between members of $V_1$ and members of $V_2$ and there are no edges between any two elements of $V_1$, nor of $V_2$. \end{document} graph/inst/doc/graph.pdf0000644000175000017500000040053214136072217015032 0ustar nileshnilesh%PDF-1.5 % 38 0 obj << /Length 2514 /Filter /FlateDecode >> stream xڍYIFW(C`N3C[bK@Jyk-e Xjyۋo^.I$w.^YY.~_үL|^8^ޭjsJcdyc^p6 efϻ~xgEDuܾ0Qun"Sx)|ix1L«jIYArf&MV$ڭL<㙁/8Z բ`X$btI%P2=r<^/iJR +0@r'>%?AmQad#?]xt9f6uW?+g!/7~بnO,x^B Gw(f~W@kCu##,b'+ :sͲ2|6*aODJaǡdս2ijA^^hq:ABN$Me( ; BJ>`Xz*TEhXwujb:k=eKM S:LNDHRՅnӸA,Q4*DlibWx)WU~R :CM#Ytz&i/$ \Vzf'0/c@kD )\j*c~01h[Ġ#$"4`ijf#RܘJbITe((܆~seim*Y%\$/+b~͡=|ushL (.*21u@]ǩ_˚$a",Ip|)Tb:{7__&+HkZ|>Nh7N%{TŔ~(މhFjYr}цZ2}Cb"W>-P1_9{!<+;Iz*a?i'g,UwJaůRCieN;^<Ȁko|]T?5N=pMDD=U: (`NT Y+.5lW {_.}b?˘"'^o Gw xU!5Cpσvr=kLqM_S*Swdzݟg endstream endobj 51 0 obj << /Length 1452 /Filter /FlateDecode >> stream xXKFϯ@=)xqmC"fv=lF6hVuU`!JIv꫗óOXR?ENZIVv$ Zq[[/g n2'n6Qe :"E#_y7|n^ݾk{v?[{v}tOKx!4 pт/v'$zi52cz#'j~E$ ;Mh)#m4Q1ǾY~惖aQ@kǣn?Oh=MAyR4 #~T;{=l؆2 rIȀ5"#rO#'<4?y"Mk}G88MO^S)ĉaRNe+lH/ <i NL1cg.~B4#2]ۢqf4S4S{j{&3_ЋQ X 5@(9N4A2^Ǜ: bۤHTA,@mN600%F KH#Ro-()G͌)UJܫXztU㎳_XLIkrA .ضR0i]a zʞ{R)s: ̗ˆN_P -S b  am Bе6UZbA`"Xpw.:x ~>E+:*qaC=P1Pvk;Qa{2}ϗ2 &zsAbqxliAy! 3NiC#Kec&yA R˻yF+u6YeI7vSfQ E Z՛G8II!gEyi7ac^meP(ҩGfC2kgfN> stream xW[o6~ϯ0bXue@68@/=}P-ؒ'wnI@"G7 зb5 Be-уfב5(e0|O<1.ymW4َWu޼d0gn &m@ޟex e ۿK JY\[ХĘwk =jbcUufyp-oZhniiIijG29 X6iee|D8D.=sIߢTXs8`Toe횚TpXlĒ=5?q6>ؠ\d\?iO, V(qЬ_ cd;ҁ~>*ܠw~14y-NJRgԅmR.L o$ + DO=4GE|#ّ8xiLPHLR3*kSܒMk/#q&=Ԣ$(Qĵ}u,hgh%߱`Z3:~*kY(Dq!ŏz6 hcG(ڢOLd*tM{ߏL9 3:AeX2}J &Tnel+kXa8'0)e)w]' 1Qм NǴ,WѪ`ƳaD_?,PtrD4|`@Al)YA&;P2Ko+YB)}W<{'SI 4N&θ9 _4Rע3W`<"g3߰5|} W=z%|^NhFײ"blJ~MjC )TJ{-Ly;w\Cw1{'fRY}@ us1:hmYow,\ a w=Yk ]}w%'NbY$ڒY ;6j|/mkܰO٦\&GO3s<63w-yPJj3JIoݪ,0J&o*" ߏ'TED<vVf=BIs"q~!vQ'ئ{.%Y=HHRnTv\> stream xYK6WEbE"WHCQ$@` Kb;/JÛl+r8g>㷛3/D%fy$4M*՟___'Ay!sT [W49'!r Th`M9Wk&3;á̿eEJ 1{2(r4-Skv JTVd[.${gKi-;[~*zD-ˢ*7h2:<2:oM,֊>U`)s=tj -svcVl׃HTЮ@P釁[p #]8=k;+́ 1 փr $ 2  zv<@z{k 3%S|=⾸%= ~M1tW4nD<uVX1Kۑp58!_ [\'l#3RZj#hۣ̭pmX4B5 -9tqv8)& t8Xʠz8ZNXOh=%t;2vrGmAꑇ.G㨸 1`#Aƚ QFO?\8bA1~_l^ IjX샥.lWxoVu+{'Zv6ڟҝRdC}Y$gw-m@Ѯ;n# V X AI3.!eғULDeNO 7_=&FQ? ȏe< oy(?#uF8N/DEߌ)%]7uE&ȍ} |RA}ACR֌#9\ #Co-G;0S~:AOsGJu8ILMì.c=,>$dصrgQb1tpS!g/G򡽑+nS!H ,lEQ.uX1Vqt(trr_}z9H ymEnڢ9ߚ.o B>h2̖]mrdըQQ$!~=$Y~0v1Bz p Oxr 2h9N+3RHJsf;x:9ײ͸+5pݢ(r Dac*3Cb6r~Lf"-`>(e1E S&m}VM=JEydVAztڼ76? endstream endobj 63 0 obj << /Length 2232 /Filter /FlateDecode >> stream xˎ_#d2 0k8pC=5ߧ9mbuu|,͢MT͢nS,|Zd3ur ?#zi|l*e"cnij<_"/ln ?; 鋟1 Ƨ hdX#1 %* N<+jx*Y_LaAwS`Pq$+[,F%PK[T(!GFNuO C+0GJeVQC|}'7]xp0R&kLڀtl*Dc3\ ؎\1vNWqɔ'_%Kkڑx^i/֟pA=1]]/u [ iP7m2(2d=(. 571OaJ; Tk-rذu@pjtwwUk߾ث_juEô%n +&kMm-:"ĸ-Gq4.`pi05 l:ڗ+&=Ya?1;m,ocY콿b IBN>!nzV<%}HA>%邅*_ b9 uP [jW# -M몪f.DlKj-ͱaA[1NZqKpf(.HGuѫ(ըj?7i# #W98B1TtE+xGSg~$<^#Wk)6$ˆ,q V]бfp 8wljHW h׭}qABeYR D=4Fwu;> 5Jձ+tib) 1g!BB_LkW46=F@\DG t&ç,oM+SћWy,Úq ks!{ @VÊkoY-MG0dM`MKֲ|m[嬨؋zh}#U o_H!`r | ){Uqsh#J}qBYYZVuls*hWz`UgK]b:,O*<0 Ĺ҆,xs@hr࣭ٚiR Uo 0ojX\JP@ߔq6`6=KDIM4H_U?f-K+/rCۙ;Xs4 \<7 2o^ISa>2dK6ph9Md} en[RIt׻M+s,%R1}~5$=ZAC1YZpku%|xxJsq endstream endobj 68 0 obj << /Length 1789 /Filter /FlateDecode >> stream xXYF~W1,ުTJpE(M";sfI`W*Jmԏӣ_X/o"kx܈d*o#ЊU`њIV2Oi\>z~4%?k֞UhwW3z&g<;ۛxEc@Psg<tBo]rIP( Ydk:diU>tb̮pj"er8܄sܝ8FY4׳T+!2SoޒhɿJ4ۖ Bg "I-aatXfq<Nb/)-2Yf^i4F:7i"k*jSU{\K ۓÇ[ǫ3n?̦۫qӁeC$/ڤ?  tpN?NFKkW=Q@$3_J!Rh^,pMGT5];0F%x#!:賘nK;v;D882,R(^r[3LT&f2bxAꝍNUqdnKCr3٭3{k`J"]Ž^W-WriuK.|g\olFG.*jc+snCM\>$ z5G?(JۡWwΕ Re:X >9a`Ն3% ܞ-r;N gI V_K4`Gz7VfvܕۃwJ9 ʹ JGiDRe&4҉"(ot-;3hVC7rvJs?_+v>œ RrȔHssț-1#4YqRr+64kRH(;)]N(G 7aE+] K*4|J5yje_UqrKXZk. oLݷOO}@Q(wHŃMY endstream endobj 72 0 obj << /Length 1883 /Filter /FlateDecode >> stream xڽَ6=_a, * 4-4HhMҶ| ,uxMBpf8g|zm͖2 j7K~8K.ly*Ro?WC}OZ(d3{8ejq,-qfbƎ@dwv'$iLH7ne&db/F B ֭(-JBv+񪉓wԢna `zt; o%\Oyqē1w<}/mYgf$ k%s0T/h<`e&A D$\{pvb ;ޞ<"sڗ3KȆBF r^2S'DHʉn3S@^8"Ć|Ȼg j5ܑfi4E84;m4lOC%bD-dsUɋyy "OAw߅?>*Bjqu3Z WHv6GՑ3Ox"L Oy ;H9 2?֭G~! x0~hZ/h?~B $IAB MIņbH)r}eHf ֬Ox7*t*Z,L[y%H^cmioeC %P*EX,ZY( sO,.h[@y+le ˆp*`_ nr) sSZ8Hc(MU$;YҲTV:Jt2bBr~Y)6ֶdRiP sEmpVGjn .j*.x5.Ӹ{;\RH qJ'] T+Zw&{cSeqL豜b)Ưw8]/s#ō< J{?fRs;Nk!b[G?E9n"0+Hs>MmV]˾zb{ o9'JYaUq+b( ;6X@Br:av 9c9iـ51fcn]EkPj]sѬQ.%;:g #_c^2Uy]n'aɞ6Z69vSnҨ8Jlֶq"A@aeyN+l&k5/Ѿ,5gةW(VNmr0Csn#Xa7ZR#Icvp娌Ȋt͡WamlOQ6hP;\K6t4Tw:ސ2>)/THe>Թ\qO+IDPz]$U4w>#m-稒cH^Y2Zyi$/ASRSE/Bk2> stream xڝZKsϯp$W$@dUdw^U9ds%Z$zEjlקP 4F_7wP]I]Γ,ϯ:M\]lV:7n L'l(W~ =_T锱wܵ;!O@*#߿l҈8#vD'y'赵;4Gd39l;I7?]FO=Yu[ǘJYL)𜬵4s6|[$8w?yɰ2Kz]KފтֳqRVX`^f|?lDY0/Y.YCPوl*p`tL]6̈֫CCII,S^rv_@ _<Ұ~:V ʱ'+_eRtGyN&t\I$zHp!CA؂ېb TIWGq 4-?[j?pmQNGn1f%P:~c9"q|85Dy=vc}3.i)pHq@>9bwД]uy]c$BÞrwgr@t)6Qq>Hv{z n4daIl{b;)6bi'WLto93FME4\%q,el({Cn0/^Sܤt즣'G ˤY2xrY0ax7_IYM M±%5v}:Gl0,6R YأɪX&~NlfxɅ8EFV3~Ԡ 쌬 49Èb~^d 䑠HNT8IlyWkr 5Fj$qMP%`Cĵ@WbK;|d*N_tAf/ dYhs=H'ej4KPTp귂Ȁ@烕UvQw1DeƽD5xjٶssm/lހotl"1dLVV=?ȂςRy[v K9̔ض͢^w27E#DR!w2ßCҰ nz2$ZrĺBȓ2!\3A-ĔťYZFaȈA}8N}zt,Wc7qg).!x̉M'I4#™^ |Jh#XMЩ!Lzy( C:ќ#@> *=GfMZ;\'~G 7Ik XCfW[{/frAm^L3+C`fX0dƊ<z^gy]otblrd#O0Jks`Kʴƌ#0rTTՓ^ pYgr}\HE8-ybE0.Ns2!河)$׹_1h^9^pyZz/wʊ_dRidL!`={ /A%5X;+ě0aɭ_pٝ b]R [ez_-P(*O=ՍZL43, ]TPF`ꎙ`Tr 1mwri5 ` 5uDq;'{E OfK6TCi-;Q0̬߿ EgoKn8az`X.m$I eM.a[>9tq ,#B5WG$c \鏨rФ}DsHc&GsG =l\B7T"dhˮȴΗ%;&@w^F uIfjh{N'<G> _-8f{fb⪏OH3T!9 @eJƉ덯*M.\Ub[*c~/3rnR#SG,CqrBUAST{&uI]gYEr8nlzdE~m΁D 6'oyIf5\29o^L?{2G3|oh-TD-ҙ?ؑa8m ]ͽ,̖ߘ90DE7 x(b%8ìTAlA] P63U-ԠOǛ i}5µ5Ι7Dģ㯲.1>.Pg$QdkV?nPP{t oZ/loDqL^P%?7.)x ڨ?;c_HX v> _QMi)s b8M<1i TQ%U*yf]﾿y_'W endstream endobj 80 0 obj << /Length 122 /Filter /FlateDecode >> stream x-ɱA($ \vTSHB $:@\#Q_TQUE&MG-nu8M [Yð,ΐV]'v=WN;S3uz3x:cE_ endstream endobj 92 0 obj << /Length1 1967 /Length2 12875 /Length3 0 /Length 14085 /Filter /FlateDecode >> stream xڍT۶ Cp,@ݥin!@pwwK'cT7m}s9WUQ3C@R 3+@\QʎLEabJ l @ d*0uySrv67++ !N| S7ks"3@9#SC<-\^[-;@d 4M]@+M5rqqcaqwwg6wf8Y 1ܭ]j gW%S{?1#S4C,\M@W5v~pe ? 0S3@࿝M@)l ]<\` M!nvf37HL_Oz@'kgfgkRd+k%{{/~N k=YY[0`a 6+ sWM+HV?&"?2K r<-@N(Kؘ5#*~i6(yz|Yjj cb.AC l}VLrf-07 i[1*j:NaҨf)~۰ zm30Z&4ǀ(奒I߮V=Z+OZ-̦FܥOU5'uUr;Ȇ_=1̷PD9^t|׻W?;bLy䞸zSXqiJ= I}c7-K+ߍ\4cJTG;~WPbX~byFv uU +fO/fX1z P֨>xX?(ܖ"RLA&B\rs#eA!R ­O+nfLfrCnHϬW= q\ȥ..I_9enLLP(_)X ;,9;Ɖ:U؇3HDUo!݉B`h~3XwC:L酲bGc QoǓ<]?,ثA 6P˽I^QN6ئvL?]ǦEq#}b3t9aI-x?@Rխ\Ṙ#7˕9u,]NAXd{QSͼҤ3OwitQӔ[n}F5Zp#| )7 ikh&83 y#Rf= `({I+L Rj7]4ߴpa\cm+wp9KqVj#\>rav퍟d[v2IO;dz,a@UI۵gáy@8pZľ_Zvu0b ~;ĜK"iGںnxKV6&L% uK"5zt8H 8W+Ä t W(}>Wn : \ZbecI|A"[T^M4[d;V@UH:.E[]3Nu<U F=A9,%krpuR63_u.w e3eY=7:3%&~@I?1B!`)͍e7=;Rctl~ڨ`Jx=::} 3"}nH|]-Qw " ;%8kQb/19x7azH;Ӡ㪓ɘla-®+@//GiWӗ,pZQCztCg?*w&)sfkKx{=uq?wTY"Խk0PwJIڻY kTt5VѶ X;#-&ݭMAoSJ:u.=8YCaĚ3_D6H}`-FVt!==flU29>'ւha>=0{0%L7>ǵ]!xV! "t#p߭r'mQPn=9!p!qvC#n`D?Ї>O⽆fۓaVMʓ/xY4J眴 '߅ГiVhvy d JsENxUx_  :?\jB;0o T- 3yJ0y,n_97i'zzvV 4+5ܿoEodY=P&FHPG&qDHH(1V`Tu1;XfўE螒BNՄ3w(YS})șDb?v,諣_.lʹS%(]uvs~ueZ49~Vyڸ~ȫxِASCΑFw+"BCͱ"vͤD(gDkq ;֍cW&~Fr1E ,FHliLj(͵/ݒ 5.(Yg.0:e)oZKiLGffMLH3%ٝX<尊S H=+ߤFԼ,ڔ=nwA+j,7[q090 N؝_ 1kYd r6U0AhbsOE-ȼf SʖU=|gCz^҈Tp=z %8Ztu6;~*# nqaʗ4g]n>/઀du|#.I(Z %a9> -ѝ}5:}ZƇ"<o PsgCf@G#s%ٌ)iy=<53OՐDU;.@/Swփv,z]rѳ ^,T5b ׇUu9 xq.n`"Six}р>[[[c0G[.\݀ۚFr_ b4g6kf%_PC,wӪa٫ߝTfCLS,_<ϽY2Ʃ,ޟ,4`\W^ |o*w}W"c8pn FƈYr'sxD j0VŒݶSp΁jlw̭G[MoD7sgC=s0,~,v'WJw.8 TV5E Hq`a#Jo .R }l#:樯x8@x$]˟uonbڜۧ8+]pF}OeϨ}S8{DLª@Fߺ+'=C1"o)WzNײ<|m]հ.%"о{ث](_^*ښl vܼ2Qc 'j{C/37[tnvԖF1ǥLyPb%? |߭J`4P+#ɔ PԶLJڌ bfsYB&)E:ed*xBhf?'`-x&G /قa*I~WS0zyo ηqѴ$O|ͼ:Vps pLN S\Q8<>}CH%]ym?OLz GruG5㞯Q6=4DD*)3Y%ڜh^XJ̅ԺbB5RNJԬ":;caGdCoOHC4:$ՠ͝5G~cp5{~؝p3-%-*赪FN`͉vɰ9NVXuoGaaHbЕJiv(wJWHP- `q^gG?Iۿ9sSuIF+H/+fsz?>cePnnHbO_>`Tnǒþ+5n%6ɚ")x7q[%/_n`*hתsFȆRFAY]diOYŜF1(E _9+~ՠBPEOˁ$-FtCDkCˁ*3噚+T /X2ڜ|f"Q|m,n?ЧmCܸH(|bZȟ_wK◎ ֩a>/XYgw9G#o{1}۾ ĹH id6L"z/ZR3n%^@f|#!Q#V= EFvpcԁBܽ*nwۖE\>sC:RTRwe,G%absC䍲_vt&mUKr۪&4lz̄F@1dm)on1|]I ovQ\sl \ZpbDk|$F7ڕi }`ߞ&k*MFʧPʮp^U"jpF#)]wo-8"S! K-Z5< Ru\VBpGJMIi zЃC@ th I1Dأt:8m Ps~8UN_c@ ^\ɟ142;hR#~ak>|5g.C#@Kf>9oxr9FJ, ]z x^X}7N:l7ZGP{y%cֿv̊3~xC'#rsꆮưaBюY!N7r6ry l<56ӥN %SMqze*4)ʬiy:oD&$pXw_^*hf_AK9כ9NlSZ9X&e Zѹ65,W|eoFMlʖPboGTAA 4R0& :sfO<߇wfC 9fgڼݿrXkB=aמ y CoX6}WE6䁽a/O~0?*%'$)ܐ/c]Ϊ{EgtCAN'!s>k+rQ Xb-k2zK#R(x9]8x!~v)7c&h[=Pb?Iic2E6eAbba,<L^2y?ei^?/wP)% {aszp幑gcCӧX&w]zK|X"J^aU^ЁAYۚ.ju i=52wSk,2T x҇AsQR8Balg*4)w< W)2QUuN e%-7 n\KۓV2 ]^ʻTۈGy'K+TH/]v~>Q4%Zsu'%x;YS vȓ2L)f?Pr$VUNV"`,:]C_2 gURjp/Vڡ9dV=o~Ru`E!1RD]arRկz!-rɨoJ_ӭkߧ*D<^U˙ 3tyҵ\v=gs '+sk_߅~b09.~~^u5b=.+'.'т!j q}jq#`pu-iYS#5w'ov/|n5:?,IlGњfFP͖P|VzN 5*90c>IMCVG|; 't< d.APK@(sO!$ tY"6a@6KGWlY )q.kCKPVv @듒H_UwfDK$O,!.gN[?Sj./'} s*̳ !@, -|6(k'!èՒdw"56!,Ҥh.on`ivAU cpE%.HoX5t FP'mbGD6 ocuEծGᚖLJ“`ޱr,^,$S( kww¢].`_W7-wj. _RO1_Fn xSZf$"l@Ojf|;Ńڪgڌ0.2'e(g |m.I9ɈII)#i b_:Fq>f^$A &4WNsZF7Kg(YvH` $cO7nxl:G'8e%*z w(xS-3՗_iR`99(V>󔿈ŽNKP G=?}ޙ{Lb'CsaZԙ$AZyXs/-Ha|TgnW5Bn>JnL ZőM:B)~uYlKإHSᖜk}^v8 'wAX Xy&*ƞi@Iy^Ok^BVAjN }xٛ]U1<$xoBl b)A8&[2i7[ʳesiiU>:<=x[ 7$۳|$$3[az߾#'2BG wda*!lǽm \V. WbIZ_ :D_$kp.Uk]1 2[6,hmJRKdC o0b#r0?u*0S$XqAǘGsm]g%f'BFvg& _zSY$Tޕn}t~9 (C9.Foi)J*BCsaWѵf2!tC)]б W=gj^b#v ɲ}4fzK;M\eY"+,<9$m75gtwkU;Nޖ_}d!ѝ2!h9 3o:uR InS2ʜm~&8U &ĿLZ$צ;P”_E^|)6B'N:W.& Z#}=_ю `j?Nr1FpYV"jY f,yͱ$f JI}>\Yt*y="!J[Y| 6Zڟ:xSM:T)ʩ-d^ҶEhӒܴs$  -fzDa@=ä&ޝɦ إOT7*i7_ϑm|<G,=UM,S%wQL{QQ.O VCa%xN8;Մ듼$G)AQ81]q5lqonjXl볞1*]I/IWSV:xGz ׹`LkTkM߽+7>ETnyG[ ȨP[5ߞ9fwwlj |'W驯qƟX_?WP([A-D_B ?NhCZS+Fp ?OEb(4m[qi֌O@A+"ׂ@2K- p\rf3.2'~os w8tʓ $'({wܒ_ͤmK%U _'. h/X]j+&V8{&"/-;P҅w#3ܲu`kfpkS ; 1;|ޟDP4Uy*~:ya!)F 1弡1 5 d.Wm{4SX$esH$g.(,.ϐUfk3,?r$Zi598LBl35k4nk׉ E /PP2?~jF|w0Un%XTu?<_'sQ!տŤ9Or!?F'r4d՘iez%t.g$i4P}}5F /80l2jTwFE ZɥQrOܿ}Bx5N;M{=ĒU/Owx|gƾ1 249~xIi&UT hEWc[_w`bțVvY ,mfP!_2k Пs'vͦW #G,058Z*c,ɿs0.\T'e . QUb?LJac)>tlϰ6/ʜk83+ҙ ޖXu0ERXț|xa.OՑJ|=,*&/(9JbxA!p [x5Bu|XxȘF ?.ZkuW endstream endobj 94 0 obj << /Length1 1398 /Length2 5888 /Length3 0 /Length 6843 /Filter /FlateDecode >> stream xڍwT6 RDJD`Ih"^U@IP )7*(U@t"EEEus]Y+yg3}DH 8!0HA 1aHm, tB]`1 XR|K@0@Ujp,[ q<P> [܁Jp  A 8G+!#4AAp?B:phiOOOa+Vqz"p@c8À-!? o    Gb .H$dh poo } BQht#\@u]aNA΁, \ v!@u%# P  c.=!\ru#qXy} Jwo?uF<>K$ ;Z pskT8Hꖘ{AEzῌs5?4 'C ?,a~>i0; G'e1/%@?0tɚ0 oik i_FeeGHL($*AR[?B_-= x^E]>?ԅyt+JG(+"uw_v߀qExA# ZpwoBX%B`qao= 8o֛/  7Da_6–A ,M,apy. K:ԐP|D%$  I}5~("D.@B~@{p>h )0\Gl;CH˿C(LSupA,fQ.axIg`Nmnٳ}j8j8W8b.&q4=HV.]"2dmT9tpU1DvH~k{eI.#m/qMv;L|r}mΩ#z띦dp;W(NMMU|:Ϝbtz;+s|[K[7xo9&G ʩHTvIC|>ּ# zvXhOw-wzrK__x؇7UL&ɷg52j!j)b*_4};9"H»{>xӼVeI(d }4~f7&XM-4*Z麰[`*+÷J|@(% ~$Y6{8FTh'm7H Q}? NеxgWė${򺨈'~7h*NǛz}Zo- ܗ%.(8 ]}D7h-qtNSNHK-%r·~s`eΔajqfw]ͼ`a?y'Wf5=uA_pb&Lt3ZEوwI[V9\&k۵6ej?ڶ:={y7hjrJ^}J#ICH?z} x"7_^EoϷ+jqI|z2CMa=~+x?.>;B"nL~~{)04I7rE]hzcgrŞ,2 v@ߝۋ}EGL.՚~E}3LY]π7mD(#W^11zm[y+` 8k1WH`8"p!gPdaO|Ln-&텇T}W:UV;Fx^c~VxZe$2Z_,SQ? 7JS"Œ-gSowe?iލA_Wg :NSAcg3Ւ>xa\pѳjJޢ2Ff*hշ2*Dk<ꖼQ!E L1ȯ-6;!tKrJA3q1"< ֍} ӽk~;ٖ 'FyQwuc[ęTe,\L5zçpә1A_k`u +)pF'%Qc X*,rXgH;u|"WQkGb^nހjO"5GSvI ?Vy;Kʯ6yJb]LJМmP!G/3$$ג?=`Z@^ҞYXQlrgmVBnD3_hab؍$2J8aڗ338(3&t<3F]Ck*+&z{c1It×/-tӢ#Ku]j5kkw+Fz\@d)ڤn(Y[9n/G&FWc+ږL$K|f>Rxf"H~DA=45pQB;܋\MXo_V)ۙ*3ǚ2܎Rk".0pLMS^a $Ia/8yM+2Z@*a+s^mF mwܹ=zj7g([f Z˻L1dUOǛ,HСdyAJzKh(ic $U̼{-ǶSr/Ȍ:}: w6D?~ر ynK69i@CqgUjP0|9mR֢(+Ei1 /Wf2BjC,! vf$*~MlEMp ,c-pP܊ZbEsyLMt/|)|up`fTbcχ'~kB?X[_lvIQ&"BLcy˷YG+ [ {R \[ĮT׎n.nr>?hju:#QH9WbiX.JZhVpi2/܀SO >Ɇ&%L8,̑ %2s?~MPJ.=fAH5$`UƳfPRIŐK#7d.=xU{ȞsRA{^\m5Kg5TEx NAu?&u2U:[C393֌ |(%hqX+ƧfOJ݂Hms1JTe fR=]X~4!Zឋs"H`{@8.!.1xU:A7K,Dg'դ[=ՠT 9rZk=$3ڜ_%t,IѬɼ3%jb.ڸX(v[gT]FY[(G옊`N8*6:[zk\J];t?sU֊$39;>|g;VY=Te7 2N %_ivM}ݫRtSU-(t)Fq=vʆ9r,ݤĤq8+R}ydvI9M9Le3.jL=xeAVsE8.U\+JNp{cWz%nP(/zu9˴I8d|9.ҨIE6+]rg ')CXQ-xߧ~܌'aNʓR ! UI_űY>VMh#w(o9KӲ)@@ nK!a,S4X"ϊ˯F'DXwooj90a{` L/L9I`5U-зݼe{/xQez_n7<4mtonzC A9*6's&lxE+T եSkz.޿8U%ha誹ȶuF ~@[ϥLnsIz-qeqCѫ\<^3e~F9_\4 t8Driج}5o$*'?x"T1UsH-~^+%U{p#Ywq&aP⤉%ŲvTh4avgja`6]\+3ݏGwsKt4ljnvEA=d-[StjZ~^fZP3#mq7%-N&FCAx,6fD_ZI>_׊(fF'Q ԋ=|O{xJ_uN+3s0j?oՠjO޳* 2]Z d+_?xD9\WT"ܱeuWKXaC>OSzx'H0%/ ~Ƞ7W gUxkWB=p:6hn?9G$9%jJ tn[(k:b\a1=RZ߭մ)y xe+,t;c"[d4im35DcF5AH%DQtD!|  =Nݔ#0z#qЦ-//hrC~6~;G5ֺFMzIBg#WOU˙i.&?pg6сJV-Lt8<\]p_Ĭos&,yxVF Gͼ/ 9Xh%k?R+3y5;)y0\A=)d-*D/RdL}T16SI"wV$Av3/QQ | 嚟\8ҊA+}hPnչ[|2}u^c(h>H\I-uff[`9£xUCαw6z5tz0#Kiֲx̯0H38MxmL}Gv endstream endobj 96 0 obj << /Length1 2392 /Length2 20884 /Length3 0 /Length 22271 /Filter /FlateDecode >> stream xڌP\ݺ-ӸKpww!w!hKNy*zlDIA(` Waa03123QPY-:X9e 4v};dl,lN^.^ff+33:8Čݭ{ ;<Mi,<<\rLƮ@wFSc[BP[:21yxx0۹0:8[<\-*@; ;a(jV.U]=w) x'Jc@wm,, o߁llj`hleeo0%]=]f m]ݍlM urc2=blbe;Eaޫ,no&`gwu}>1+g{ٽ鬍Ͽ$܀b6yY]\.@o#8+hae'h~o'@}X̿?y/3{[?/*?G'" a`g0r0X~Q217ws2ω=^RpxZ ϐ1s0aM(!p_Ck`M5,<k]A?er)YZ3-o=P`xoҽ>R7)M~+' f@ 1wG99L¿E N`LbI?$ 6'3A ;;Π3A&?=#?O?9?6R?9l3Q'a#ag-sCd|XkaC?[`G/w{|?ټ7hŻ/~- /^=R{_-ホo:;˿5C_}]{=K?eBN^drtz8^){{wX{+'H@n1us~/n@'ni/Ժ6Z߃ao Şf ϒsg/wŸ{PVwĩo_|N?$)}6LPk[?'%`P}qo픡ƍ'Y_2>_) \!F=Z/h"$kʕynLi [&kZK.9!-4a Oqg3WDUC*+(oTI5%ΤUQ5l6@s;nsTeuoYDm˓n_Nk# -Í#;~E,►+`]@i eϐa>W"Ox,:ܐc|b*.:6gQl=CB8L:S//q-čSdwYR6̆2]nV`1x%ns,^ KK-TG{Y?1kTs)F16 ܙnߕ`9h<^VxD nq|P 墘.)Vx3 kBv&NbigكTZ`I_XA/nu֧@vj/(k_W ۇ5^DUrɼ7Az~NV58m(Iv3n6>PGGG6{/d7N DȠ٘1&N%T_ 0擲>Tծc}%P?d`~F$U|r64+vnvϝh0`C(9*ڸ+t%6PT*)a$*FȥZQ R^.x8 ީy9($ R 8+rߪ eTxi#YD,%0oGv_և-/׿nT44TWg  p`}q2GxuA d3Y֍W(UVkEߝ)ކE^K>";ntKnE]3iaٵ̣Wm8w y^W R6Yj?eWeqi%Gd}#DuD$V"e{Yg4R+9m=71$aovLJ`pe(Y),M?ˌӻ9˗x%8IJ[߃X69Q!ؗ'eJ3:ywiյRd'v/{(6of zMˊwBćN$rf?*wNwY4D>|:#aNq~$?{ Zbw(TJ["؝K@a6 , yqw-%Cq9T=(KNf%yq> Q%RI?[*<*XM0! (HO5+p+VM( i2Nr6o{l)Ysx4iTEK9KE6l*}FZ %Ia@@B}TQ԰w 5/L_d} gR5Q7^ v8˾f)0eH\'g""K1E_yY+k񞌖E-},#B,jihCX\]a5aJ +e1ALz>@NhiDbTVv8B`ԔumDgsT72dÓP2vU4:1SBD[;V'O7hV:T̆u61VȨiE]6OrfއM!R'Y_i AԶY&?*bHKRF^ٕYe]xOS9Vm|bNs FEd<=LX%4xjx6,Ngy9_w#f'-3:|"Ǵoeys-5"/Q8%[ m/x66H ~1Z&os쵼hbm[$@a~PRpB8DQq0\> L iԐvi6{%STF;D˚ C.3ɍBP!_ 5(Y=JlgY5/k=NyLH kJ1yF+F ')-]Rú94Pܙ䇫R)rUЩϟ:d>ii;j  ?*=U=y CmQ@^t}Kҥ[LGr> HjvŸZsF:gp,x!ڃoSp > +6&=XgFrUy0+9>hr-I?YН]>c \lӦ~(qt0I𚇇!%6a ~zAόmifᢔfF0wW51I) քlY}8ܗ|b۫=x˰VĻr🬂m0P`7m {@HqRV>Xx,@Bc:o YEU+豭 ſ6rH֍O(5 Jw畵ɡ6\+` 1˜SP گ v(> +@2!ڧD BcX`$6gc UOˊ|\}^%JhH>TvL+ PpK`|˻ !Sc-tYV"N,97т[2lF|—oj+'ʒKsJXsQ$5"JEOSeg+I_ lK}5@CVcsT|F,GJTl4TŨu,PLh>=y$++KqhZ ^tJ+Ҙ>~*=fiLW9\βTa/_˘ -Y27GCQ2 &1M%A>7qXLc.ʎ 3fj >c|UUΤMjmeJrF50|zW;ӨqQ0wGDHU2 -n%LQSc\!Lն{5CmJy l2):i܏m#%dppT$\ezXKSI!>pvz|D"JQ fx<{ډ뀄m& U28%R*QK tPUֳ+ , @t#[Mzy8(g"){m#6_[0wJ*io/5${93J=#>ɹPUi& -Om3w*ݼVɝSn>:qt{e=?t"Wv~ٷ╺ַ֡B]iT :"xu(w;cغ˔ѣS?s_!B1TPnRdSC&a-jgAJh5>|2ŦI$ŝ*pЎj\uGul+ +Av^{d&CK/dWY͘KMO5,K-x, A. ~4KqA{ BJ;;] ohZ^O_@vF9"㍋Y6#V)_$ "0clXnO&↢ɖkzX '}W w 󂐦NykF+*2m$"OFWhՎk)᝸8y`5r{(?%Ɯ_80X?ged|V8[5bcL<;Ԙ!{Z8z`XW^_'wH=.iH>HU:%7QGТψ)~_ )zRr:]J[G[ ?&bο(l+ѭuf;,öyOX[ƻK|NEzZk*-{m{cbg/\0r:~IS?G/HL8ȿIk)"= Wgbu}WˆGZgy^ɗiɗ_tKZE)(C[$]S2+\H]DU0+?e#:[aЖ>ܦ(sתi~"[K}c(:?;} 6Ӑ;r,|4`j*qG.|!*+qB`ed~=_״4ڕox[~nih!M:Ga ›㼀%&+AFδ͐M$}kD;{7M'K=V#Jr)LQe) y5ZP4$@3 (!tXԯnjپݠhЁ{3%B@YLnUW-}-5;sKPLhQ@ ZU{rSs*ݼYB2nqN @r(>BGIsJg=6| $gE׳W-8l Lpl(*ĆB(zwϼ yhfH}1a.ԗv%-*mЈGp#?|y򠩼@t4&+hZŌv/,' .CZ<lis'7WYh^:gV#v7 7a^άq1YjQ52N#/Ԩk5@k$fet+{,/(u}g/piϙʡZ+tw5g "<!u1٤}_,Վv LJ4aVkiP4I;a $Ω|fҢFLA~p PNoQk䱗/xA k{JQ¥T!}X}OuS?/Xδw5j%3D>m%GѿbWn4"9;$[1+t%z:&vqNWTտdsA Ц\[yYh6U'Drz(lW} _*G:6Jפٍۄ@Ư_^(~}U˧`;OcX7cŢM:1y&>>|Yu^/xGW1QqA"+8TGJEO 48Rt1;;n{]-rS֩=i.y#ph , jig4[z-̦Iŷy:$炫Q$Hr{*ވk5#YP诅?qSg | g^CyRcQAaFiߡ1gzvpz U:c/8/xi]١K5)Shl(v>ABM3+APi&08̲k25Z =Rɱ<1D0i@fSd+`OxKf0 4Oҡ)AbVT1=nY{ :YF$?<`M==CVSӟt݄7Z'E(fM:IL0)P^3cI[6ȰoDViFijdPVBLyQ?5e΢ǣ 7 h\fRxZ۹Sf=\^E:$kMt1l=u R5ciClQ!L_aUY̐+۞zHY5RA/!sb'spXJ-;EC8698OQ"pdic̰gdAa+sC]y*lΝj|+j*рx&St|K.X fiUtj)/-, Wra0h@i9? XUrJ#z}䨂lBy$rp2DM 5wJlןo㛗9eo;3ϤC(/sĝtԼ9akUHL] jͣU?YУV16pr60inEW.OϜMH@@wh>,ʞWduckYm9}]|8.:W&@񋿎]eq%~"':9(@4-pꤪEyvvطmwW/NQVb&}𑼜NE%2 0qeK}H(_/fۋLBs\~BW\*RKvGr-ruC9&SM>EO$H PHEkA݌R-mv '3nh|\=ΘtmuW}F`(f~2afS DF]⽃[6ߪ AT Y JcS3+"e LPGlp\ꔎO"=#4ī%5kb?̚yDF6'SNxOO$qK>E*ɿ)xN VBGHqucb&Pז`>鼋} QMNr <q+JTlT#ߤ~J I%tu`FŅ *W{LȀ-"HS)%*nj[@3, ǁȞ8/Y(ȫzot.vÞ/ʜriPDVyrR8G<1K+PEAzq0Xb!࿅6EfT藧QgC:o!ו~Քb/W)nz87.ÂFc%3N bC-ácdZ}mRXVC C{YEP{Q!d۔c^`}KM#NR=q$nCS0eSA/qoҐ'x?cBECCYS"mI<4zW Ñtѝɩī v9hh0=,sk%:cF,H,%SAwV+JRw 0V!IL$b|Gr-__i[f-'ʲ/0Pdּ˛^3q "C(Zh0<8ld/8*BT)/XһIuyY?Hy*%8ct];D͒$@r3.R!8q~g8F:]*::kN]@ҭ>O [§ [sJȶ\Jc)P%eN]>yXڰ0WQԼ4E#dc%\O W \u~͌zr@2<֒>GEWaeN8ZТݱ9u z 6 |QFKxPͱ5 <1CRӤH?>MqFtyf詽~uEx'S[dk .77}S^gV;HQ5f7NOnʍuƈgRlZ/wc@o!ev@x"*D) rrz^gY6E PfJV-!he+bRcL~4!0ߡ~$~Œf$a|5dmPo8S$ ݑ͊C24u+ d藮fҼZLq[GBwRq$\(#;{9 8d3R unԸmaNDg:<τ-rcq̆'PʓWF¿lC $+ݿ2~.<}MЪTl :Usrb2IW7^+j  )C-o lLbjMZ !V/z. \}e9CGA6Y7916G6߈'CfH!sܿiw Z (-n]R z`~$B@ *u?0XLZJla|vU}RbV,|7Ҳ^!=SA&Aў3*k— "@ok_4 Syv^r4q' W } ]o{dKl<Ta=ʄᮦYZϞa$ Ja7!`qpu&յw :)0ScIU+dϑ )oqp% YۈR8̉Լc5K>c2bR79ruv:.4 2W@+`ɅVH{{ d6F7ɎBB]3{/&Ս?{eC`'&KGmmxJ ( I/q؛P9nrJ-7 |Q0eY粓*K6x,~JD>b#~3^~& YmEћ߲Z%Et(F/(w5U'iA@*OW/I݃GVM{,"YwҟcR Wl\Рq9՝~@H2U|ɉEX=MؼFJ3&Uۥa ÞCʔG6q4h|xvΑ66jwWzlrN6Y֖_bI\>\J,O=KO'IГ{␂#_'r;q]ԑS⿐~M$'癃vb'r oy`GS{M"^GʊO;^PR6 ,!0~DUB5+/FRW l+g?l baDp zw j yڴ|iONܛ",VLP_ &($(d1 iLp (xIcuۺh*ˈt<>3$qwe@5 C!65zFNh( M\]؛pȸu$7[OrJ(K_^ XgB<݂**WjOLj]CG+? x{nBcii}vEr{OKk iάPT79a8.ĥս/ a@"^-d!ٷ( Beڰ e&LhE|b8L_6~}ߔb``㉽ubHo+ e~s=)ˮ9 K<p;!++_J/?+"K/}$#E43lf E[B੠wURב<·g(|Rͯ0?a[@ec=<{c/e)j)50n7)o 0G O-R"#q6\ t-唯.OB5m g:PC<KCeA +9pS9rYRߏc)Cƙj<Ed"BvE|$3Oߪ`UE79yܦ0)+T0" XEjOuƘ"3F[Fa ,x̯iK?F'VӱaCšVP/vyt iXCBF퇻5F6l}N3 ^)7~+N~sހ uTuGA,_FifwXp~gꒁoD Bz:PsuDJm07iŭGi0m^VDhw_UMqpshjt%BG}'N?K#D$&#IV΋- E?zS543o35o/n }Ђ`ŒYO6J#S*Sٻ_,WN=L3$`ÜKgg4 ՚sY@lmVn6eH4 ڸCSۇ"+4P9  JɆc׻/Yi<`hXdMF5VC=ѱ_ﭓEq_Xs -v mKr)er̤iB?ܳh'ŔU٦Re] Ð/dt% d߳PH=h% L,9N4) ֢P3ߓ람TDʹ ;iׅ^<2IT34>Onu\X#B̺V j=v\K &D3srE59dV!!JaUlVK-+/|]t٪haӎ]J dl/F^EjSW2=ީ%8 J05c%7. A $pP:Ia:y_˪YɕuByos TQ@F7U)crk8njJH`d6JƉ>c 8N-,u͟j2L=ƢE,)R ˩5$T۠b=]`*g_"6WQ-' CcqHsT26av|WOg7($r5yBnC3c\@1͚љKPZ'.D2l~*䟎[צ?IB3ޡ 9}h;04%|3jea7c7U1P8g7p`#plgG71)R J΃W'qpCCfJ_H0'9ύL6gr8uQd˹ᜬE̳imzK ZhK2f"sH"lYRlf"KTn^v GNvDSBA5-) 1dVl?NZwD>&<&S鸆<|/\@=qK]CCXEWрv܅B\! sAu:eFL}Q@"[35A:'o"2Y^u{(ja[cpu/V' º@*+uGxYR&tsCno)tL #+VԋPPB+4y JkGb̅f}6>Mt^bfi%E7q.V>QQ\w5$xLk2qBp~HTTnfb`C?g[c!frsLRΟGEA-2 )( >a騏aAg,`"݇2A_ >爢FnzOv -= 5'C/o'u1kKn;C?vAnnLܧs jms *wA`q^hN_zc,WC9ApHԑO"S+`.[h&Co*u묬ng@uj3Q2VǾ#a DK:3NңЫa1$5܋h4DSy˭c3&^=Pm\QZ9( Rf!78.а$7 BLEH"h[̅cHV&ݨ Y͍D$"Ib`-K(IG~a"ڤAF:o`y_߅A X |žʟC.oH /%wC޼߽6ޙ0崶vHfI eqWNjX)oz){˂^lk))WV |HiZ/ B7 eX-W3p}{;aN I*I'ya[Lўp~;o>`LӢe^ /:c?Ɏf vHd5 &)I=#`` . ;=A#׆d(Yx#_w g=ܚyxS*;g9wd wc_7Zigf’m-3}`hQn&wnM4pjW!}M.,i;Ȇ7]F5"O_UsLb^83D>V rp +8hT8F;ڎq7BTMWũx ^nl13@1B)@PĺqDo8 IJr=mtB?-cCOzr+;| Jе Hz|Nյ\bPkWQIA:s&Q4.}M'oY}~ps9'dx-X9 (rxjm(&J5q%_1eH#teL \&AaWoe6=\KMWAYŎ7* DP؅Fj^imsv-}Py]IS}㊟ .CqD.[fÔ9(r":qCUf <7>|#ɻMc `zN5am ١f/Ae_8/La_ `wXENLW/X!T]?%x*qCnzp"@.*z7<|ɃBy)|T FLCNfŃZ/E@>ס{جEw!saȼi9PA-I{uSe-MH_0rL#c d\7L:l\VG\^HǨ_"ѽ˿Gȏ$ {?f@?^_t-7 \襘#]쾜{7`Z_-:[QL+v(C I(^xy X>$qq/].=ã]XYє؆+_ڷ*Gsd5^5p#Ϊ}ۓY*ij%qKM@6ٜ d̪]H#ʜPձIN~ɺ9XEW?tax{* -*j4ȦUy3J[P K uN*d7h"hɦ58׮Q6:N.(* Wj&'ڞJ) Z]%ѻECffѤeJB$^'ۀIL>$d} ,xgPĜuK7oJKkF QRĠ0l_zC$3]hjyqlna>ɀ|ݟ\wT EM\!Dƒn?VdDN2_>8Np>@?:bY`kkNgB1"2:GCck 1_)1* CX0;J%3dOV63oa\ ؐkHc Ǎ.zJgY;h{Y[]GgQd|ڽ/(wYݐuq,0ll[e}SC#kaL Q҉|_n}ȟj_ww_}$9.p֡i>*"aLqlNMjkҘ: <R"KXXѫg=,m3N]lW ્d'.j#~Pu|N8ܔASs(6 Pq0ɟHte t/e%ql/tĿot&hB6 Y > unE8 Ĕzy~,9碞"A"r8`ehPuY61R~f8Oj# rY4PryC̔qZVcg`+J  DMn_Ȓr>"XOgfQʳ ?4,1۲ O2kK+,B#%]5(WF>2eWk%sU}ep s-9G@,7ULeH<|2gϵmD{^)]bS,* ,ECW+T+a!(0(|-|T[IzC<@jc]3+V8 :kj)#뼔Kr>h$`IYٱdbľBĒ {2BY /Tnmg?)q*O>PՅM6=(GH?)Y΄4@I#fFɲQC yÈ\jXˆ"6g>6x,G;m_Ekoԕ$z'qeH@+VÇDȂ#wkF['\/kEӥb6g0#0hF9/I@:; $H]xn=vA^ۥ$QcfQo8jƚCzM쬰iԔYBcs;x}"3}yT^P*d~7|W˖+}kd;~fp0ۅPӧ/|Agoh2O)d2|s/Sle !w{UxQBZ)n<3',KR]KpXvթXPU969_^K;܈a)Ҭ(7$;7Q#eWzlϊU3ꗸQ1rD NWU AZ*2't]i4&0?e8dā'~i=ڥzzep @)S, 򓸑#]%k@kMd!˹mLO[N,מqNJTAy{@lf1ۄ9BwX-E:V ɒ)p 1]{KOl0+猲` endstream endobj 98 0 obj << /Length1 1533 /Length2 7526 /Length3 0 /Length 8546 /Filter /FlateDecode >> stream xڍTl6L#-ҵtw#݂ ˲)!-4)HJH(Jߪ<9wݝ{fkn6f}#>E;-D Ju @0?(f pg3 ݡpʧ@t0 @P (&%(.@H) jhaw|6e8 up@N0@PRRw8@A0: rPRp8zx Ap/0C^; WȟƎP?~#7 .P0掊A#MmCC5    sC] =5m~^frqA^ E]9h=w0pwjQWԔUavpWWW}*P$uaP&<&0'DS/ ʅ"v r:G{T@=<@m `- '; c. XQ}g khoLI  $%$@@࿳胠U'TfH)5s\҅D pG@Q %!-H7 W_f==PׁT3ȟՁA=]@jP>G,& ݡ^ ?jΨ8>R0!Q1QB V[~@#ݨ$@@%)Ba-7A (Y ᣢQȿMQR?@+2?_{"7FQ@| `Y8X:©.FΛo4ۖY7:/l y>swyCTaT׏ ''Ɵ}Qg3V`قީV)A_B~ݧS_45e]-b/$Qb4,8| w|HfNϦ oy&[|JXȽ{4 dJ;ZsekTci.;~[#kvq){4OZ5R\_0,khغ@o\E $ vp9)̹ )` 1[ ԫ+#+͒6 -!CwW}4gbv7](N1w;{la;5*AT_q.$ou$>pȠS9M1!ciNT9}>;d7S|G *WϢo+mA8N HbC%cXz8Ҝsɳ7nbA1E$?Iͦ SIQ]h:Ox[-ljB ?; nIUOz캘\Q1WXqD#s3],{;+^ u)ؾ a% b} #JIN紸!CYB?A/oEn(D8SeѿƘl 96x|ҽ䟌 0HeYIj,.|"rG~I^`2%Y;:+=MbRv \|&:]Smy[LSHSrn8KVKWj6d.jд}=3eH9ǫF0ƽI*Ĵ% 5"dfM~~psW6 9q;HȚ :&f6l$ ' !7ve8.#p1&ǧ]bg?4>0<uB+ 2ToxRnFm?ON'nQQ4'6TjG(>_FO19HivXfU'W̾¦GyTpB5[ 'Wȶx`$KbŪt&2;Vwyr>ֺ$<<ȸeBxƙۘ gK^1Qy>nN_ݥ!܊%{˥7C C~K9螘<9hA/-~,Θ(g{73bnp\,Eу.齼P/;Z6̙w65~ib9@ؕmJWCȆvi19܇E8EFU*v)kL*=2DE!ɫ1>ךezMb3EGF,F nq61k56Y5_(g[VPt?m/)UEA1rAckC؋jFawwƪR^uft(i/.~h-UpO))QԹҷ=KޭJbm,pq`g&ɰ#S}JTkbxuoūS1̽ܜ/ wyF9u>/0}(+۴~(M }Pc7%FP+Q.Vy7}mpru.d^>'LB۽k'\'zU~ib}7"TNLza'7D{gx4㒈ɡ-.65ܫg\!i=lr4tO&J-1C̳h/zj޶) WʁˏgR ؕԪϥ`if\w Z~0[[a6 6!0F",u4+9=gtACɋ%C9e5+(;m%fNﬡ~vu-n3o;>2n|]/Y}+B5zbI(6r12'#BjJD>Htx#X*k^㽷12|!q-Gʵ[A/5MjFT=|5aԄp#o "P{td,<oj68pF9KMۋP KsMecL6;b&/#7/Ƈ0;%ON ;jo2s)9 ݣk. E+!$5Fς jxɝ0WR2/p0lU,22HED$iPH& |QG4U I3Ю{"jSeh}(hgS ޖ6-䩫A Ԭ2\lcv,~;Ϲ()t_Ȋ9Ď>\>XNZW(ZN,Fh'n#,#qRdeZJ-3\àR[1x^ի7iHؒċ$4麈Y$b~?_0Xc@a|bQv >Fo4m#. xu.-to=)ë&>xՄ/Ŷu {B<+,k]8 83.$_Sg#xB'v.I*L%-B:D[ܐ5ᒹDN*̈,!e1No:IhnfvO8 w7 'V}lf:qFekbWhçs/so@fxw>\0)Ϊ;7>:ة\9h",6 [%;GW;|Q(&&2R3ȉM*yhXQ%];tR#;?zJK8GS4FEwfخ% Y9YV ?U\u/>0%u3b9F\vAs OIwƦ*ݟ"q*ܤ0%%} `+i?ZVy_VYmƬ66,PѶJv2eS$^\ kej0z0duF%, ׯxt|BSS=MOR~BW7La3# e|irSOE9_QNF~P(\OP!Ss{)+>kشñd|/O MubxvI+ 9mώg8 }Vﳯi[-jlI6WҟWHGeȹ/<):wpI,J?KWs'9~C,"S( hB%F*}޶6EĀ<}DMOV=9xN4tYJK{;m^%s<#7'4F6h|Q,^f]VZ9ZlT~I.`[G0Y(2%k0kP&;.τxXnǻȑW@I-pťo@wM %$Y)^=N{}[+nbE2gxzY@pذϯ*6c *hY+ 㔓av1iK'VXrЋT7:fq-tm0x'7z {n"_ L<:\}S]'{*_F^+U6On=?h9:6Y(H0y)sYcg a pZkuéHLvGUOsJ0/Ϧ>#B'_&P*mP<5{L=k1h;>-M `2A}f/򂵾k^45X*=G$we<|s}2GQ zUF }X_DzALV[A.H)9<OtܖUӟݬ2GB=V:E\soBjgL6gȰoi%Oftl+u`*ꥩ9C'n Re=jwk7_t36!^RĬ,:{[b?fVmcI]d*k^^+@X6 ɳ25vU8vS91X@Zߌ!L_=8JfiQ˦|A]"'xKpڤtR!i8%3 J(qne֪E܋}!EᑠQq8 ߽)ogG &;KȢǧA'񓭞Ԯ!m:XVѲ._и8VZQOVx`f`= BR$<D8VU1kީresu%7yi:M~bQT2 Z%R7 &Bp瑃Ɛv(:)$ Ic306 "K]?|+~&^W* "Y-'qb̓ЗE!{GP2/u8CEtmDQ# ˣ"ۉh=H Rz{QD7GW&? uy[ua !fXT˴SwO;"JE=6;He}"HY帉ʔߦj˖c endstream endobj 100 0 obj << /Length1 1569 /Length2 8647 /Length3 0 /Length 9678 /Filter /FlateDecode >> stream xڍT6LJ %!= 00At)%)% ݍ]|ss[s}{ $ p T49\윘tt`o3&. #@ dhpySWO.@ @ lPa(a gL:)5z0|PhX؂oZ@Zp _ ¶..llPgV(#3b 9@V T-:cŤhۂk]-@G 3\aV 'Z 5`oa-@8 @MVÅ`hq?[Y!*Jh,=gř "o)P(>i8vONwy 0+MX: CMـ\<|<#eMm~~l=`z9[.N :arp@% d~<|'Q{ߟ?< x'iɨ$%/.. ';@-ou U'Uf UUn0K(Z?7fa>~q?+O4ɺB   ;Q.W?nC@ _Hl #YRm_vK@pg[??Ώ=.R[0N^'&8yx^ha+ xl` w}|6ߦ?o$`8>>2> X?c? X_S:9=t8?b.Bv5U/YGERY\o'2Vf9]J$~]ޒa_T^Yv 8QXDm/2mo޺ȟ?+}ptKp#Q[4:W d%F'8p.2sͅ gr ?{R15~ W:ۛ7+eڜ$$')y}mb̽W4ُWb0UD޿\| mvqFU#^GH3T kxz@q0lt}SNɄ Y%|]=;ۏmrez#% O%-~E]ROkYI,jeqB# (|=+sLHEi܄\[$JJ#Q Sx)Q܅W=Wuf aR׫- Lka IOㅳg tOT+PޅWujLTdvڣNkg(-1WY^1Xݒ)h 3b&Њ~_:btQ1T?яljEY:AG ܘUftp'}0ByGjS]ٚw!pKkN*lYG'f NxU]i(¦O 6\o6;mcQM"oM(ˑWf gq}X"#opDXD< oB⦚(X#zV'ɼ;xBiE'jgŅQXTd3I*iF3a 3ul/;L_Ⱦ1Sp08o/ۺ_pr^lIBy^Qgwy|5&Ij7I苊 QF$Dlb 6X6W,PB+j!~Ź$-^tcefJUf \yB&[1=ĢoujEsf+oQϷ>k gNFQHN+DE>$ٸ }xV5!Ƴ1J@jQ螔Do"-B#D)noѢ Y/~nKd`/"Y< mcSw]~hicizH4Gc[G%AÅ!WxJ$*VémՈM# l(!&V+]܄%Q">]f~фMfV̼(0%`}`ɷuOo@A ކ9κ85̙(WGSB'4y]DQ=y(FR4pvޚaOЛd18?9ҕ}O}lV|S3&߭CegU-TI{v+;H%11ePQ۝bt)g_o8؄<qҲT;DSVrd *&$(#=;8=^E9]ZPO5 fNFWN|;b#om־/fP!?L-J&f-,&cφ$鎅7Oր~2{ vu/xYiJx20ഢSmGohO}d1ZK!0T*I@9]E'GHUpxϒkZ^F=#,ēqIvQgKQE_HReQ΅#d^OLo5_@if4Y>)()Yw jc|]k#\x:nw8 ZZLU](Hx3?(K~@ 02ULJⶤ.xL| ˓u wn uBL l8p|/vLZ4귂Lj?AE:U35^گgcC/ <2׋UJIXM+@,/ёtc rFԙ#RB~9Eh%. < ڥgc7Mia0I+#6+;|51Zt8A}e,Hg5[x3?mKG5dECKO!*vO~eͦiܨ ˙MDE|EHx^Á!-&jIt}F'; IU=Mqe+!Mйey?J6LC![$rlXv^Ul =P h ][h݈~x؆I0ywXT3Z88ž\Nܰ1ҡѡ~,u<=b|OeBikI,&3-l%6~U Mwh˚2%YM2@w6K%[FFATIY Ut)_zGwjp'%Q*Α1$D{f15ņJitT7_/>(OL80!BNMΪ֊4ٶkS0Y!y@5/ Ӧ\"(Xlfznz >A C24Փq݊TfbY@7}'#vg ɇLNtSE%˃pdEPiVu=F΁Ġٙ瘐=nnu >/TEF39->| rU&*)v>3sf^F 9gl u5 VLbR& NlEhRbU}dȣdT6_xbiZ[EZ z" "7& N_UI}!%i|baFQ2ߧ:R!bovi( ZId.{,!`sު `'#d1Nu%Q) 1ӜD*k}, ôc]? rNX(Պmc'z6֙^qqF$TTi` ('&6Q|Rp'Q;Ik621% r}{׹ɾ1Q;5u+ftt.Jy9l}ʋ$uYlN@lwvUb@zp/,r͏rDsE3_nh](3tӸa)SU#'6vΥ__)i 4LYסe毻٠sk&n@S;>̓,6|6ʹ| L!w ? Ц(_uDɜh)d1EAJ]FF572}yK ]%XCKlǚHRӛ|gIJyȦaRG=kDf] }jE4ѡĭ5gs2ˊ)Xlh7ײj2 lHoV]hEm-3()H+nI)̟a61ڊU3Zw*;8;IAX?J_ iN13k^}k9i+SO#_=5ܭdKnJhc}ƻD%)NڭЏng8vu50qЏ)ayWTDTz3(1>-gO |{vc19 50]w#,|iM  2$/ͅj͡En"/-R^`ՂTA/5?z绋JbI,qx%Kz(JNL,)V}os~.LpUv['혰vGP2h;Va>Umg}:Z5(l8T 6C$JjX."F2'w=r~˷`F-"do`6 P(,c9-`c:phrïs*yFZm!Ѝ=s -]:_-4NciK \,Z(%ъիoCu$㶰Ns@h{ѣUohHm#WM ?q(~igM:xUHő?PBqsd2~?Z|x.ٛ~:3p&ƯX祈9r{C˶5=!Rg/->(2f Qj+/K k;#Mr#M蠔O\ikT!! nh= 0iI7h8TYJ:aۜ*Ds^2GGBpvB}pHHr MЫJeFP%4{Ϥ %rs~KUwȢ5M h"sf$|.TXӤКJ^YqTgv_]snd]/&(gS*< =/ m! a~~f`01+mxطkO{WJ%'NZϢ{ja5] Vs8VȾZW'n3g[O1y}Q61~XD!bRj!KJ`J tC|9.)aoT]07+%NHʋp>MHf}#DWB>ވ\YdGT~嫕ED';PxبUtBWH3ā?1skAJPugMkPWXzLXĨԁtņaOUE#e>8u([ogm =N'Su=XY5T0_7nc3U%ee!*tPq]8HD&IVw=JE5q[Zv*_iQ'f{3>ܐ`Wu8*akcm7N !7|$)̧n novn@u( Bf=:Tty}QҰǺ.Tf?9Y+mdRg298?ڹy\8k^Tb}f=V/X7Z٫ ,r#pzUfDߑ/yg@3p.K^R%tFg:C~c+@RֱߘE W$ga/qUÆ6hTh:`p%uJgh &ĊY6@+PeD4}wi-w+u3THokM~2ɚP1fEk!dlenu*mס`AؘvkIXAaAlXbU<6:a{i@fE];hDX$QLM#bSϫ+[7jxup;ŽF:Y"6QXzDeפV:R3J7o/O p=pj\rȺiS6<_IU`e>-[O/#w1(lvu9EY}*nu W>[ (u>Ƀ%ruߌ:lXҎ9(tRGD7U\aΎK|yT^ѣ0P'O3ȡ @p^ b f 6M屃﷋Ir R,CS.[|h`Jaaw 47@d줫0@ YAN4xAg}8ǭna;㼊i(MjKÙl;*M nRd=2ǭo jzCk-N4tLo\"$.e"UNdQ^^q2a@8椇*EjD>#ϲT#~}!|%{Qk3?ة[a{5ឮ'G#7 S@'E mx$5z[M ! *|i.j %rz"-KyC}#" o6ČrK:q̺'J~6zԛj׽ג*~s$[ҶZ3oLZ60-(DžOTtb8d]c4Dy4˅mCrȈd$n?!^b)ӌb tGo̼tnJߢ|7RWF F^Y r8LLBJA)'^9/ +{кWY(Ob*&vV/*4VԜ*8xxp.# aV9">AVEݫw#D~[A &u@#{`&-ɥ_\yB 1i2ZP`KtSPkbHNJ-l-GБy'j|4(G,z޺7MԳ2^whԪֲMJZc3?E'=0UHwyXaŒ⯶,zF6 /-@o֎kZ_Ը.´Ihˆo=0E/0*JeRc5THgG(n 1_);P8z26<_޷_ۦAs{5d񒣃Ly7<}ҮQim{,э;aԖ+nD1ǐm|n\hv+?>~@ 6 ͐4*,춎AxyJtr|֯7~q2//bf N6 Y}u .^9t&_፠{IOwtLqrnÞ^rOK5^3k1me4-If{ڻO, endstream endobj 102 0 obj << /Length1 2357 /Length2 15138 /Length3 0 /Length 16527 /Filter /FlateDecode >> stream xڍeTJww3twtwJ- R4twwK>gw~*2u&QsGS3+?@\Q]ACʎ@EafAZ;:KFhIDrv67??++ᅡ. ks"3@@%bmiߏZ3:_Q{@ hhfbPw4y ZA+77'~OOOf{WfGKa:F@ t~ P23@o "Y\AJ@?@]Vt[XoF`cfvK`am(K)0y1L ع:M?"X M?dSTX  `@6 M?dSA z,9=0@I@@/7-e1)o?Xqo˿@",$E@aY q+o'+ÿ$@4APymA !?9@MC?ALA8aL:.'%8N㟺sdAO9 Arvwtl .tAn:y,nV.@/ǿ " 茳;ȼ@>@my0swK@ aqL ̦>VГi'G/;)'B63w%ì0C Fp0%|kU.nƒ|kƒE J!UR 18e'O09Lx +xA  9}S #" Dϴ^ѩmVoWmŢY~)݋ʽjqI6/:>'$!UBh 3$rtod(hQM[lǧH2_u{Ezw@ W#eT"0=LA/P-aDfg!:~~LGt ^"Uy^0S Č 7}GV[饟1HD_BDC׸Ƈփ2@09%&'N0j=U.01o*Lĵq'[P4-Aak4KپakeZW CPY 3>:efWW6' 9I(]Mi%;y%'@f2KomunF5L/$|u3t.ƣ";J/LNF 'rQ86VQ:Ef6^wO3Jwzbe}!-mCw7 L4kG$hlg:hmNzbщ2Pⶠc}āE/㫔y)& s mZ\+,j*Au+: 1K=|۵R.ҨXWL!p}NVP\ƦWQDa^74jƅ1ҟʩ8 e,AR0Xߪ]Mނ8|cܷT#ȃIa:b 8{k>QI5 9\ 5 ShQEThEaV` ŽO\ٺ,P$jO3ԕn* /r2|[6#}T4X mZՒN?>@fJ{V~V%S'cfQzY,ā3 -qf Yuڢ8KR[VrR'ZPH7Jb-矼H&I^v}8a^ 1a6F}_6 n9rxhNkW>Aձ"]?s"JV YNAO@y5"gXɂz >p6lNeà2-}3H;'xq=dTzI3"Kh̿{I-^)뙶N΂[PwhցfakIɇ"P,d}Qg&:NvWҎPWqJcNӲbJOjI1I=pC*8Z:PGLXl!pDcT#h9Uh~}"y$Q>d^ Z|_v3Nr'd3H9U*2) S{#Gp=0l|MMھ, AUyhgD{/ lDiȪ]aq\z4xch޵-|Cr׺Ն\!q8Co>-lKyrtvE¾/8U0#$IV̒ח}MnN&?].J=ckR;flu)_\\oij(tq'L7m;G( 2FcV x^&8o iL+JJ3<Ι.+MeB%MqnEOk.<'ibA:[ ]*CԂbF>H%!;6GD&~ UQEgtO`~ {+Ekʼn/҈\kҤ!4!&X[t+)i`AwbFP3 ޖAD5 _cH/Ǒ::Y!J ~+4i4b25'M(܅D#M;]Vg,yZ=TH:C!BA ȔcXiیaYW|\e< h{r-w\np40JHDSxcmAM~Z̺sljL^~۰~ͅFGӄUiݳmqzʤ\ 'nm ^{ ](X@<UC}s4VRYJHw c$R;OsDF"O)_im^ =p%+YMiS. !%,S-HL wB|j0t9iej%a؋x;";_؇:7ϔ]v;lȼ]cE2a@FŃswVrǼ?kMAuFT$mX镌asTxoI|rz3s=i)_O赙k.~_-)o 6;2'%0͔Ϭ}lTq ̧H~l# gyb1l79r-1h`0!D/0>X#[CC>d>72kW∯dq&:<B[{{kQ; 8gZE.CP?Ԗ<|$=lYPAPFW_jfC3$&קeiR@-:0kmH5~离}!~+OC!IR\ 7'W 2^73#aMjeu1'~ seիtKPa*s=}ű[ϳ?;, ̴D|Λ;7 a66JޟpuGNl}V3J"/ClٚrJJeA^VaLfoxX !`J:L%tc^Oasu^hYqVtumbL2-9~"0| x͜&ΰ&fkd󧯕PhݥǴLӧu|=(AY=VX<Z^vwH˖$툂J\=lk|oш6pQnsk?Q9rUZ 5@Z~~DP;9u!;w}X/yL(E HlMOY[qM[1Rz? Glt( xF#Ź~#ܼqz#|$Z竀̮~t%ݶs&wuYR/Ԓ623 % 4I2FLǻnßFM;\FF|O~I;Urr# ov50o'OEVlTOCdfDE!hTM;4q2ϙG<~s ,`@x&#VD4Ɖ <+k`8tzuXz"|yWVyB =5䁾]V y^W3ċr3i {>F5!JnTAL!i\#[kIkvV2^:\UQ ѱbW4AJ@@:Mŀj=Օ-|+ fDH1пmNs y, `@N>α2˻VI@=`Kvk)JQ]b<]HRUU0 Jv<7tX_V=Ӥ hUosf Yl%A"i$ &lΰEXyNz}d±we~ T 4Ha>/BVݿ̖=$\w \V!BV[ f!btϼ?VD{eW0(3\ *<| qѠ9oiZ P>w(:0ErjRaYbDsNjHiȞ:YPkMGDc%~ wPblj]l8YwHhqX~ЖU~53.qj 7O3e|?4ZL5ߞhxa~Гrj3:JZe^6E9*w6dqEˈwvTZ L-A7vAbmHA;#c[-7Zj l2'.{λ*j͂<:/8VϬ1cpXsO=S[H: C[pHG~ ' TzD2|;PI^tJCAq~H%9a|p %PJ$5:ObN7p>kX4: W(# '}:1`:y1ezRqE @t%#E`<+?Zzsrz 6}Tnkҹwaf{i 3T׵鱗*ɦPޅOJcvM`!\H8pDE!%j SUg*C'Kdzxهix?@ gz2 AN#wQX}#~8>*) G.M4j80LV Ŵ$W<Q+#{φC&V/bv`w"{r6^[q ܎!׶+'탂Svf(;Ď3A#hmx[ΔE]ȭί-`<=?-۞(\[Ba PF-=&r;_0ſ9VK!^ʼx7M+M+.>NI!a軚s dF yv17>M\HK(wu]UHa%FeayP: SF xW2 eZr|wGϙDeʘ]6QLy|J$2dJtR֦yxY.% {:z.ys!qa`B0Ck+\$mJb3?0.Xh5# 7s# j' ;,^fӈ|6h;l 4}6FuA^(mmT]+5x:XPBp(@)#I62ލnp^fB I0nօf͇5Mt},KEF"JE-Ę![G /=KSTNܶ^ | 617ncX9-=#EfBչ½EdoC2eM4|dW)B=o5ldy'*^McS2i7O N ''|#VL,XY}nʂդY3kI>L%>=.iB*X8S Aq(&IСqmՖ#'OYZCYH*K eCwjy%܏cd C,`b5iچ <>1fyՓ:ҐvC/BL쾑/Q3RZ5'R z2˭@{jtkYS#@;\3R~f"vkcVt8wF ej@"v^7ΩO8#e; +ͫFBbyJ7-х"wG K9PQ˸F z (N_*) z%="mۡ YTl`9\(jɸ긫/+?v@H Zj =qwOvm$6gۥd0$/J3ٖ1Vx>z ]2}f"Yb4z#zHL2M$MX=y4_ 5YN>l:n1=)h(P5l6;=|RsYY(a܃A_tIWfmr8qZlVLq!F)"'jÈM{xFLh߇⿻^@6P yœq9f&@IfXM'tod|-L=5&0<#ig2 *Z9!)st$<|=)\Ә,JmNJ=%"ӆ-3CwND p V|d,}mB 25#ljlxK3t5;z=*O<2#3Fa?wdUR]=CV|xTBw0oc1M*::rm4|]4Nש]Y|#[+e39aon#ezT0g\B6𴝥' a7߷l'T6:}OۄqH[>z[v#D+-$ߗQAVt!$^9؍ Zf""Q[6SelK|vl?s蚚/]r8cO lIrW~\FӣZFFtDc=6ABݼ7^`7XL;k{'⩞{&qaK~ŕTL0E7PfGLFfRRlGͷayJݘ'A; CDw4!~xW'o*^MADqZhwgLSѼo}Mkښ:9{v-ܾ+K@bzWyg(ɚ>{t6% y̝ȏFkY*5n? ]"e**M`4ɷf ;j~znOƚPk '&*H?r+ 1,GalG>d"6ҎU"zH$F=їއ_.:c5| IV"z?oz #xቑc X\O\ŝ3tX?.ҥf\]&\~o#6C2CzRiq-m>l#(h cWߏVSv_g/!%3i0FTa$_6O.Tah&)c=u܊RXJ bcpq"n.}rz9ހ_oE)Vd16cQg?9 kyl}Tʯ28>WlA ` T_~f"('QL]uƪq# ]eO1$/MG5:brᠩ(;q-HG7Ɩi(Pa,2c$;C Oc~'- A9<8}~j1>Q뙾t#jRqSC42Pĝ XiVۋ$ߖAySLA![YͧD ӑH1h%1ȯ'WSU/-eOF-4v~f-m ?'nƅҝ?– ǹf^F;sM'j9+RyZy*a&Z3rĤ7,/_Kg slbYƾ6B/WdAaH2lb:_ռ)FtUbƥCj4Ǐ%4xUDqL)jᇏ&q,2/}tG/arafC}x `rWozּ :!yר0J+q%\#WW5 ld28dRc[>*ǎXdjCC%ִtYbsSʾY x"}Yy|ќ'9`5=@ 6Tu T3>AfLoYB29&԰ou$k nIM@_\c 4<+GA^׊UD$= Ya0םģ97LZ&G^([B[姎uc{B j-*.!9 ΰ=o_8[ >ߟg&yE_S'_4)1J̔. q5Tz(fgR0?|Ggna7JHE@5;?1כ !EɈyJ2RD{\KrWxQ\Yd,|9*J ';==/]*CC#)X*Da'mB3=dW43ƇiCv*m0==ӡD4"LvAW#ʹqI; B x$7Us? |TƆLfÕN-vwטCpI!RT9:)Lh"BzvaHR hT-wqc~&YmgۀY! -Ui?+S^?TŗctLWp3t>Ue0?ms2 P %U_D Z\#P=ceM9T2&4֏wnP% ,֑?;saڛ~&NVė0nF;L6"CIi3GsM0h7?gMόѫGBWtKKRJTb1$$uRi⫐޺~t.XWqchiIKfN+r>Z^!HF^s(\*`BA=MTɶT qו̞H0 iI&?`U(Z:7w0qL*W{c>cHRmVφuyd1 |^&0Z<6n֍gEլv֭kupozռxq'pZA[.'fBA8~ R٘z2[LĒk_<ǴpdDJRj-Ik溳cTT.n+*49|nB̠,wgEƇhXI\l3IHģYĵܭj^8(4Qg )uWIT,,$_DJsC}dnJ/sEY\c 76-l GSܶY{.9Z|s9Kag,wБ9i@t}[DI /9:3IqN_Yr2}ަ#,ۥ`WXBn;"Ɋ_TU˯S9\<(EcjNlᢡw[s%]p[Uaޚ0F|2"n6']~ͷ}4?RSujiYJmY J~*_.DlW׽Ŋ=SvHˏJgb=h"I@3*C%-0Ps_6'vڴzg>24mzU;i 7zFKf~ے3=BN4]s3$!ҳpHO%fhj8\A0"=yj\:lN _En3&W6b|e^wWv5Bs@uFο&@kFꄙu>yw}ǐ+SŲI%Fvnmjnw VQt&}tЌd^?_ʰhR1FE>F[FR: ]yQzvklH\B}l8Wg1襑ˌfUb>u ;*i4N$G^3)w^jKX<\p|r5>h&{Bގ#`VvW^$h^NFhYc9rTɾx7P%wLY@|9xYmT~Y^HVatsJ i&r5P6OFZ_ W6=FeZ5*3#TOuj\2t,Rd @zXM+/!oQn"++ٹހ*%(o|\6Wڏ]4mV%;aD]u]5|ß1BO;eL1P'ES\ΊZOJ w.˽wP MU}ә!eN? U*r/smO*LhTm%٫vYZvR/0B 杨bnip,S8[G&8s$\I^LTe |UK]f ]DP:nRm4W'|bj]R(o"C[2Utj4+ R#])Xz|˿' CsZg [. c(,6Jj?%`"{P-Z٭aͮPֳk6zq"ƼECFt'Q쀑;!do'$Ȱe51Uڽ›]Ưqh|G"+A.)+|;)P5ϧV^3Տ0q7?l3DR8GH>{ַb4HTAlK\L#çm0R $/~Q&mp/cgSzG1U<8d [ԋdE#R0~_ˡ5e+^mFPH*}(1aMz4g;J2S{h4HA5`8/]j^r ;;Xeyr QT|S>(/9ڮȋrDO^g̰X`#9*E%WGIT[4`{pFN۳c7nTt^xơ;Sl3A=4qJ2oGuՒD>ќz!p>a6b+`Yu[ډr6*l٦O^Y Zyy^ijsyHJݏϓ~:~A]>8 VG͑bM|mUw$ -P?!5ܝu#/*&x>tmr\i$QaA+ 7ռw'$szAޣWݔȲhM$bѤ aPdJJש(1&ZQ4/[Tnjd,\\ߛSf1Ak. &1!őHVJ!yG`J/ͤBRȼI##0DA~oӜ&a]aF{ 䓭E礐~jJ[$LjfETx·}tU fʴu#czޗr܊@a;H)f.^Q+GT7HI LG \yeD|[D x+0ѯ#~b\Ol6m``W AmN=A@Cw2b!q RMvKxE9wf:QM=1,ZDӞj'9QmeiBڲu_P͟vrXfQ*Zz$6m>YOSA JC+8sv쀾B\GH>sLmpw:Vq^-o Fx7h %]})Vh_Ĭ[ ^m_]AaL%N H7y(˄f*- 2i.ٞ^lW5l;CP_4,a ˦TIʋP$_(q7@9`|tW8Z{kM u^b߼A/7=3P^_q|Šos_-D^drSCCϡ%la|–mBdk| .d۪9I=MJ|ux' c9[!jH:. %#),|PYjGW9x{Zq}l$D"c>͸ڝ2RCµeT#1BՒM b&Zy4KkQ;jkJWRHݜd-".dԪ"I dh"!w?ئ r#N~{ۮPI\_ kdBZ6^c)q endstream endobj 104 0 obj << /Length1 1805 /Length2 13236 /Length3 0 /Length 14371 /Filter /FlateDecode >> stream xڍPҀ |p Np`p5Bww5C-}iﵺW,̀Ҏl̬ %M96V++3++;5&lZ rt &4*9:l6n~6~VV;++ ] 3@D-'Μ;@27u(oM B ZN,,̦̎.VLt- P635@Ba @@77 -;@CNtX/&߇`cfor `*Ҋ`O0CS;W7SwSٛoݟ G?¼=G} ۹{}>!KmX9h9݀rۼY.VVV^v^4f#O%|om@?H>@ od@HD-wyYƏ  &?ENU\WOwgbsx>7):+`ܷsO BXʎo 3\o?.(+vSOd亁߶@mUZVl bVo/9U PͭZ ybe?%3}{E\FOm7 0uq1Bz7ma0;8\o=,]Xn."XKPn#K-K V<D @Cep̧9SwE 'ShZ5~_n$LM_gD!.bN,[? B}zT.L'5Df2.o<9Ȝ)LRyYtD} ,`3%WJޓGDO)L }$L3BU,|a'qhTկ~+{ 6'%,1"<)?',+[WDR,}`|E F!8C ;jivT/ F*:Y4_Dۓ/& 2e J|4<#xsHQf"۸` *3̲ f(4x^Opס r[ZȓC̷ԩn&¶r]C]djA5Lj\T6$<XoʈQmS&SLZ 6|N$J(J@Ze|WW]S23*SReb=b8YG ·裺Ӌ:qcQ2iXXW,|P9s,jڄߊH*-uRj-k P̧/E&qr>Y&dKED#Å2  q{OwG ]/B(Zh#c;8;Ώ\{$x-6 !/w -Q{E^F^gCeWq&mc%񇄧,\v0;r9G% (WKKDJ\ ]%C߁+9If r RzUh_ԥW@?B:;Z;>9 GB?\}@]SKe/TS&< v9 B|_<($-bcQZ4^o1܉T(SN%nGH3`>"r;G"a> %0; 1:Υe@72jzuf6%!d Rj%PG]*4ͼJU\4 s>X-}9kUV 7Ģ=kQY "[uC@"w~B,w)v]mRaҁ$1FϯԲ-aٍ2Zk RkZ)-4=\{O{= ׬^_3ĸ=t(QKgoOS2̲%iHjKu%pBnSS$ $uՔMޣqd&[QrpK)JrI3VJ&<#>0]M 'QD y+˕4.BuTޚ58䪯t|rixs94,/^WWTLym/Ž'.\:T/Jjm#'c7,6BcƊI=Sp~+-q?#O<~Q7U*68b=!>73# P`MOgw^+T e C䰏>NPnĠhZ[\)±1r-)¸Pvn 5֪5ֲGĹΣ5~!>U?:W0/!:]>Zu`DDOA1wY8m[W!;wgSu44rh:?4@ZbѧyT~(m2O@!KE_~1#FTMSi{< i%B[kkw6ylK!'cA@{{.CӃ&b3뗙՜e/L!ae/%3NKۦ6ЫBgצ;&&T_o8{1Бƣ6de2Xh::ϓ?܈=)o AGT-5Qf2 < }d}h(e$KMd;8D$(1]VגEXl"l Ұסa*NM<89p\--FON9 ZMI3VSjƾ^'),HX6{k!(j~ iS;T@){mdCBȾkGq(fӼPi2V8^V]Jl\Ucxw"{F-;```B 9'51Ů ?ʰ {-!w#"s }(ͯٵ:ImZJD]4nA%td9av/|Q? |FcId/<yaVoRqY0K\-SJPw͚VQf-OAn23.pod(S8iMia3Zx0NG-hiI^Rۖv4SaN ZBĥ`i\>!Vw3+,37O&>n8ou3*mͺYz|@aFY:f`G@h'gkdXȝ;J+e|@ͬ.:*- ?`O!ERH/T C{?~@AEVN]C3{@mea_JOo]s)޷p r8&ẙlӎOWqW,'z E*S!WS/!iD6~,rpdĪ5zXH d֬KzY)%SB 1GBYbAcdu_'YM#LDNR&mq+:Y5H:T' qq_s(Y}q͚ɾ6h%q#gt Vl'gg gKOx, 235y}"Nvݓm\kt%? Ÿt47"tl%fFlˉ&2CW:>̣ՋT6Y%ڐIk%.djML|Xx8DDp@cJ0ɶ!G)tY :f,`؜$f8i<迉GrT`,j73z}h[h.w!$(MZT-u,E8l;79<@.(- :I3Ih촵;~Zku!p,NW@7IQdzw(o մy1 ~XN켎H5 _/2> Ȑ.EYKӭdtL58a9Ě1\q]ƅbO`]h=F^T~^cN=Qһ 1-ue[孭~S |Ťأ!F]ͷF+ ǭi"z5 {,RfFHج)ٸD .5o;Xu}xo-m*69'|^ue So` $N&jF-Q-bEUn^EO;/5 vH~5HҗX]h<)zQϗA*`訏I@* c> 5}V1LP?2D%hh.Zg) i]y Nt儱 wwi}⨣ݑ}={2<[]^7.N0HG 峤H1e{B6d&>/%' ]/C`82a =(WVbNDr6Ib˧ չ +t7#3L|iR5JζQ֕}*R  tKcª  +ǰsɥDεE:>߈=6'a;<uVZ'ml~ 7Gi\1MS0C{95ƨ U9-Yۙ0ywQ"_5`4^7{Hk-ž/,?pq%Xp֞hN>KKķ_+rj?RuN(| ]FES@kX7P>I1ipٟ/=ϟʛhg'2kl^=pis L "]Yjնfö~o}ׅIW89̹)O_ g2:?؟mg%VT"tPKN]rwqF"\(z[D#^/[ 5/ bAF[9T8x0/rOaDL}!>.\r4K$rNj5@8,6^m""W)AfF#앩L~IGD_ ""*uUa"i65̓$%ۋ,AgosIɨ+sH}a ]BuNօP/5v=1j'L Gxx^(g8E/Dcfm(Jפcz 3:"!%BEKRqvq&Y?D?3.ů!E+ Eg~M&fy/ Ua>hsx8[΋R䈌G6ysqȫzՖ"PK,*A!' HN=f`2Wolmʔ)O5;dOHzBx.`8}oړ/<:kCasm .2ۓDd7yl3N.%jQ=| 4nу'G!Ҏv"yw?|B1lo-tܷCD%lS&r-Qd]{׵;xyP-K1Q1`t1x9la\7jOΒoj[[T6YX7~]܌;l">0Tmsd(F>FɄ| Uw԰mE<Դ?k<t1FR%=6JٺtOk.1 OzQ9T#"s*AoE{=hEGٲѣ5b+A^5 B]WEg;-TCG{}N8:~cDED/ds ~8pVP(Bhc.(^_MPn)?>g+-LP4dYB>6N1\f@\^ٶp (eMo^})a֌(@cxZ;%sQi^qa^Xshʜw/~9@L@EF9` .JRWK*W$cFZW+\a^(laĭ"*HFV T+W~Vi62eEk4]. ^n4e.}9;h+ ׺sQ?)Ϧ?'}hfXj|JuT BʣjooL>N-O^A֔X?:u|6'|խ;~/+)dEo ]fyu$^d6SvϟwbGw$+LFkpMݬdrdI6ErfN=@*H6>|Dydb$$ M I|Z6eU}zl8":Vv`VuFvzyڒ6Ce" _d ;tB}Z~kSl$UaVqߩrBzͬ'f+~ZS'Z~S_ul!|bΜ$&TؓOCjv5wnB_ Ǥ&F!P^6H\8&.T%" k 3Qd=W=ӿ2{lLʂ: `I䱛YN.[>J 2.X8׸C(<.U)s4ۖA(F2ιU")il'CS˗"`';U&|8nV9G/<tA WMh =Sf5,-qN^ÆQEH;o Y`oH@F6f"ܶdYVU7f1zaI+R`L$F uQv`#1@z24Ր40:nk3J†ؕ'w]t"$ Wxs +.8xo7LZsV{B8xN=qg36;2^^n2 ?Q Úe>34__֛iAGN$/O$+ˌPmN{PakҊ8D")ⰳn[]I~ 3 W{4ANo'L}7{{,ǻ[ xl_Z0zCAnX"e^_`e-Q*3xa\M>ə3MDõ'pX-C2A@;g.۱ SǎtAj3aiG!ˌ ݺmTe$m1!Ղ;F桷@P}Ϧi`i},w >iE-,"cG)nLr[V˦"A")o"tm3,4'G?h Cjh.sGNVKǽ[ÉfV|te| @C+(Csr!UoDvVT9w% @AOUm)U]2Rf Z"k_)=w@0 dt-C)Š׳(%FЌ  {_G9K\'V ݪY]S8:HjqyAoK NC'e ru'o?p^M|ތ eq;8m70 B ޲GWU_UP}5o?ZY0C 7l'Kӗ"뎟2r>r+F[aU$ڡ-+Ā`w?BT/OgǺ#:8c B ]h=*"0f$/۸w4=AbՑsM1G[DWYAxr+Oo?@V"SzuÔ&p@IΎRYF`^iFX=wۢP.71st1GQ+L{!i)q/< L>W&Jj0j4<;F7K<fhr%JrJ&޸!Eb"B\6edK54E%s9_}uD眚}hwC.(zNW&.#-ZI~Z %xՍ߶eܳn赭3.Q|#JqHaRįޅСAX]a5$&ҐUHh^ e٩ňvPhĨ -xDf ϡ<ɠۼ|\O>cm~PrDI5[.$[!*b͝I:ɠ wJx]k%*RNtCUjwY Ȏ%ۧM5Pw~  Iǘq^ ~/O!;O{V׀ĮU9dEq)g ƾ7EE,p[Qƍ^:E:2•OvUXUMfZf,KK+WFGVQL5 KwIAw`a.w?M$MSXsIb4kN5}A&B V QL >XKN '=T5МRӺ=NX.$y1ލGN}]_6t>UP 8d^S}N>ϹāIgsYOTrHNxr12mG$nUJ5Ә5u+ 5 'De_uF;p`K>&>)'AK6Il5ځEKgre*~gu&+-B#f莰iϧV(]T ,k)o6juj(wcD~o镤p!?_9\-mr^YMh"CUy\"wtQ'گ$.6.֏P)+(+ ڳmu16E^ҩ 1{n0C dټxlkL o89|XS4+bM-C%. fP? VId{>|jS/Ji} /Xŏz_"giJ:" qND}VE8yq2>cE* ,?>8 L W+H⏲ID8fZx\9f79l:B S]w@)O> stream xڌP"݃o!={pA;G:}-1u\9*(sgf`ʫ13XX,mÓk,Av<u;ČAv3+ @#@ EA_)5_a[@3 @dj tT|ym@t7KhK2@i ϖNv̝݌w)= xP(,:wdU_Ʀ [{c;K; (!L03+ ojlicl/ aes2uwvbpK#_eޏYLdk sv#=sv 7;"sK;3d3Y:nc:ؙXY@3_ @՟1cbg2}yo:ͿTZx'}n]w@ v7TŕY_.Y}N@3%Kg3K;@|ejz8\ߎv `h>I,/m4k v :9+`0 e70AF? (q߈ (1%  `2;?蝋EzsQqSAU4Fzik0q46̝Y{v0ufCw-f cDw9Ͽ xb7doln'/7C,?ZS|Wjl,o4\@@34`~:;9?B@WN⟄waat3vv#]kpYy tw>SGOп/t_[wOϓkQ{}wtyDI tNC]Z%~:mm kKTn~6Wo_.<$#W:~ql!upBVǸwt,_]W>Ex.V (Y 3ڙ;ZpYF4ui$$[ Fi]ca<>==5߁Zo{ s&}]hYFVo5}f?~9T!090|4M NZwwUB}{O0ܗ1Z#ieskN1EԜVbo㢂kCj7b(k4vhroF\eVm6O]}6ՠ֍KqGpZtGv^*,^3\*}a헋vgJFW]癹ѱՂ,Ͽ#ZL_iBÛ EBC2^Qǔy^ F@?T`5:ߣ.WffO^w7%?zKA WcqS_8keNrkBa/0PL; ) '87[bGsdK3VHq@mʶp S?~;.E%Ṣ87f#Vi^:=$󥼲Rs3n'>KbE"*JźqdWU`&%,N=TρѝDb)h>-CPoOhoqU^i_35Gy7 lFhs5<7 2M>!(STߩd~0f[|VpXp}D(J2 UdP1aB-/4y[JWC T qL[eFhFD` TUж鏄(;H9hY[J tCi\=M|Wn?YbTU{'CzSbčd'qi `Lm. J$pGӁDr(ϭ=L~g>D5X ;/@|Ʉ\#ۥ݀4 e)}&2 mփۊ/ݳgPjFg^TeyD,'eݥ1\wğ ىcs=Gd .1۱a47pKe(&q n)( H^A8L5.'Atx:^0c` touu1PeΨR.fw hٍ>WY`s%TOݮ9Z+Vq$O(2,]{~*ZܕP#H"hGFs(o@@8و6u t$ ['_1ͷICu0 _Éh s~W +` nq s+:7zGbwdnZy}ZLL#pZ?7L1sK^Fydl:! ,}E~+p+&vHu"<sӫZZ59:kPYY·MYqƫW][`|V8$E׵CXқ;ՓPz?wK.T"癇H6cVR0Qn  )%*p]z5s6Ym0#J*H*1y %OCjQwZ% *]ç,r'`/?SsQL`1ݦ$17rFmbd$ jy dڷ8|!b4\\@<W> TcL 1?̞#>]ICO+w6^bw&?%IC%f~M 5əy^^_q&o7 mYN5L"ȳ֚ [u."8B뙑 m~N};C 8S pt)2 to00r\Cp9$@B>;Fō]m5@ @bV=Q5 q_gua_eh*3ԬeZYdK%2P\Td0D@;t08t[2H4w}kmlQ,.2 HVq z hi 9"{4UQ$}hnh"͜3EJgIX%2\#*k 8z^cF.oXč%ɏ[Y{cC8CdO^#_r%+ꡮS;m6hg5R#R{`e.5.3z{_>1c b7bfL("\t686tV#YF_ƳkWN_Ꟛ °/J9m>ݬc 0^ENXklX%E.DdIIz6Tl͜f3Ao8?sSfsv>xyAk.enIcѼ P M *'OYeb%.~b祼)j0(v@ᛦ{eArO ™TzYr:j(a‚ǙCڴ`LwoϫQ=WgPG[FV7a0kN8BEiFڒNS |?0i(yJ1jyjiS9X 9 iX6K/vMkr+J=hRUUhmqVbM0F0!:] K ?0m~d-2dh Z{C,Z7o=DWX" ~"-r3<3.aBw`䞌wS/&,e2WSV/pĶ6ۭ&̊*XvI1&yVn7` /V[fx{ i澷?7iIZzfG|XpdNab,Y]TY!2M|OYz8qM}Br9Q)!x.;!K.,n$&<|$OpM֡~\dqn"pu؀2#Bn]]eU't ; AKIH|Zf@Y$fZ8->[Vh &nR"s*TtڨZswQc1J wNxewYGЮԣrx}a`/`KX `]Z`e/,">Ilh<7g\O`yt2.52mzTB Y2-g8\pj瘅yQw@hכWxLؑcwQ)XC42 LmC#C-% \$ W4rw&I򲸩^& LY`P ۢkBbwJ گ 2p%̚咚HdNU($RJ.7prZq(1`Ȗ2Dbwlimz[Ļک!`EӖai&A_pfbhT';Syh~i|]|Ρܑ1*g-4gWHhaUDs%^3N8(?tK#w`cZ-CaI)mE C|s^_z&0GI˔ 0 GHLRliLk( 4+Cғn:P[9FU'-ڦKYzmh"q^?wVB QCW&¬0G) V&TZnlo9vҜ%Vgs'9%d^}u$#^M8)ۡ;m= S'=k7ڌ"ik@1=Tg9AQ& > 2Y#v{WI|>1n@7{=s}5`bAtۿ&#"<+bO]>&}F1M|z6vAK d_ О]s`C`}X弜C>I:S2 fd8e!xS}si*:dU|`BLͫjc~Ll<xbAW'/^*Əc~%:.7^O~wpVGZe)^c8)Sdj^ Ŝ'/|1U>i1_X$aQth3=n3Dā|u0{HEn>ч'3epR։Qɋ@=/7ɭB{ܚZA[NV'1~«M3d!&w66tHv~p)rJ=au럓L3RpѶ%4IG,뷢9z5qRV,ҵy~Z){#Cm /PYb=;Ԧd2[Yw~3aUC[MJYp˖*!.0*W $f;Ͷ[KTq/ p@;H,J<7Joe>τznUC?WmC krYfc-&t(5ɼx|Mo[.e0kVzܒcAM+ݎ.ܮhiȜd4s`aG)1A`Y=~~ܩ?pmQPhH&WE# % ea@\=(#'còrܕ+T "+AP3g!+= OOAĹ[Mɏ>n eY`T !HHGY=YJc d:O v^GP\r0j0rb#nx"|<]~uo`#*!ofP<09[|ftUj;nO&:!jH_o&!ZXf~P~k;͟>.^eRE!lH#w gF$_XyH#^~DZW11$V'ie5t T%nôVeܑYg.j]"FR*Հ2u+\ 9<qnx3| I+U~FlRӎ *1ثBr|Lv;A1ؼ#<M!t6!dA.+ vNk|.S@asxυۜԽAtV5'po2'?LҫjZ E7uQ`7=I,PDd39W r2 'lF}^.k-G5ay '\VHR|"EݽspއS/lB!q0!/$ &no^D!k1hSbmN&t楶P0_"m[ڇwejh gFP~a@v,T,^M\8Y1*#mk߬;W0L4ZQ5"rY#u&՚}9jZ{׬P̱*>L'/$}w[WWg§7Ƹ1-zZ<FJVc5$ݛ1soqiе` bLZP s?ly!2ˇn.I2:TA< V˭py~GMB&+UutJ"E #cs@&Gʇ5:ZAvZaڿaϏl D KԪmFUrO< l%P fiyFjith~U1lM(y$V^R2 [F=^ B@_D5utҋvSV]VLG-0E|~Qeǡ6% c_Z]J(B^dã U{Vo/X"} V.&u\ܗYAxǀ ba}~H|x2/R lXL/Ԋ]鷞rr6QhLK}sj8}Py_b.?scy֍Dz/߳ E~?h7_=a1;@WZc9Clɹ{ڽ3s[`=D4'6Z qRO]2j2Ϲq{Ś21Իe>:X` jPX oukEdF&~KxRQYlĢL ŗ`o'0D(W㩎K~NfD'NS?W8ƕA>*罓-Rsv1oj8A)Bm eǦM ,^2h%*uYu,ȽQuGhAK_D;KF%_HdK\q&%2Vz<{f#*I=vT5SO3V)'"OW lr v0A(?CDM>LcJp C{S@_Myw~ﮑ'::=?$JP}&.|x\0%EI}瀧(% -viqҝ^FsK,;Δ%pIaun{ @z4{XO|g#w&Ua(<.N\Ej6p,$ꐳF!7]ko{s> d]-0վESC}ӎx<*2X9BgU]OELl7lmӈ,6H8ug̰/G&o CDKRq~SAJ5sD>Gָ-+$(u`*蝑 m`Qg&!WO(o> (& ^s `:`DD\mB(a!JH>n,h to҃՛_9x>2DZ5pTȰ0`/7*Ib˃m^.Ggr$`yпE-V%IyV|"+>\T݌>iK>g,&[>E#,gxRQ#&i޷w,>m%(E8<<^[j1EPW{ (o|s(95G&-e沮:3Yc6u<|ؔ~!g{QSŷ!-Ӷ&c`fy@{)V!&m S5 / ٞ F௴68 kM[6_ɳËew+ 1I"oU4-*Ysu|lIPl: Ƶ}ZԻ>fO7BS}ntY]{kCLY`$6dBe5%X?f,u&5J;v.m:/ǔIY!rt*.6*խo{p02-h)8^A8<9F u ezuCtb+wj^&E|l$͂~]_3}U X GհCdԐ4%A5Z?a CC|ު)sE'!y%KP! AǍdɷj ZefsRH.r8mW.iS3B%B AD!AF#F>AiHYCi"hsH.޻ha.Z.d~?R1%:};=ߏ$TxĞ\[w;!2'U]BxZp+r_!LHCXxWR"4pķ-%^ЖF;Ð W0f r͂{-rXdAU*(oUN΃cz犉~);7Xu->e흜5gnT.,*-?/)h#*{ibE}h.|;3Jv=m)K6+1-Mt@\b]@;?6\4!&> DGRS/hOH06E(q"nV>o aN͍VgG+SPuFV |pZ)K#p8 At? atnT=NZjV` d?̍cGHzWSRh|#-5Pkhbi(J}hke#^&Q;c$E:"\EZ}т6E QzKV\Ru`'/n/|~(2" \ujd 0jO&1 /pG2&q koB J7|mrǧQX}Ԁ;X I5j7Zd"FfwC{9ʅtTMi?^Q01z3>=z, эrxAMXc$ _|[ J4a$i~+$݀e,ʓN0M?GaCmTjk1?ڑX~If/)5|IfAq0ƪiݪk@FD$Ufn$;˔5@ dA" n 4@YxJM(p}uVY۬ag:B2$0Tl [/CRd0lhFYZqMx m'fYk@! ,Τ V8W좢J9Ge;37rH sK1*ӯ-v dw0z퍡~lBAPCOZ<ߔG)ՙ_"T,w8Etd J$Z5l6(sౝv@G,~}xͲD7E_p̮Cj91l/#ca2r?Hq9Pʤb gzikvʗczg-&I>;Zr`Ifо6kn^C pyN0D훗B[ܔR!4$eb[| "\wZ1duz3vR7F૨Ihx/R40 /{I Qj:'y0QZqJbPZ kd:DmdoCьϝT՛ox~ׯO8ºga4ii٨_tk5`"gf흩:㢹'=g7l_&ᘣ=3!"v>Cܘuù> endobj 2 0 obj << /Type /ObjStm /N 97 /First 759 /Length 3162 /Filter /FlateDecode >> stream xZ[s6~ׯc<;;0錯qnZblmdѕ4HQm}Drp.98$@1T,ӆ  gB3a g23L &I$$'-SAb*0fˌ`Θ_|i Px!? c셴PL@ )OZfP؀x,X/x.,{c `jaK}O{YVK'.cRg a#,2 > =>kF2( p=ov BoxPo SaHmLCF*8UOd`/ТI (l #pw^N2m!(v$2D$*P S$>2x7 EQdZL"6&d 6h4&$a.pQt{z^1~d|jTNbSᤚضX&EU&ʧU1b1d.Ḽ.;'qNDU1 kz\C["- ,QuS FySXAi6-nq>\ϐ*2QuN^8rRj)A=tEŖb8w,CEd {`0H H=sFiD?bhw鰘F✿|L& HݷrbW2#8R9m\k0MqLa?хH⃄Ɔ~ GL u,ј-ja"[2R82J*{J&uđ1Pi98.)|wIzFtσ Adn+ZF? 5Ȩ'LKt6gf-k(<"VqODokmnuc kO3ǹ~\/d"k\n.amz}""."ONˠ={28EeBę"N<%;ȝ8V'xqx1B+&X| "QjT=..'.Gy5hL`D=U>OT;XZNb|yyM:e+;--[mql55\7ZACYVغS]a [*D~!d@*k|^?젤zޔjym.Ƹ .ΚB;}pLٚxEmsREɇ7X}%G4ٟ(]+:*d ݃K7m@Z=J\A6ʘdZҀVQ=#8g XURF޴㌑2biF94-iч7Q)b/ʐ !c݋z*)$ڸ S}/gL/d/&qF h M1Bc@R怒*ۓq*?׀\LJ+Z|}1?9>ʿ W|OxIoM1Cm1]>3>E?J~˿?_[΃ |_~nM-`}z-)-YdĠ_Nwau`=YۓسZ`qp#=PG'~ȯa, |j^g͠# u(J0߈Ը?o B?[7h"$ds)؊{WPi*^]%ׄ&W xʬ8/E tn<^1obϧESSUʠuxfFMڦih3)D؛ m#}77?''f٧hńN$ ;X ;d6}0ͻ1o2~ǝ}9-.O1Ym &vmYËڜ_ONLb鰉?|Bd}7uRM{|\fLcPd=6?rrJX\רgnqsg<9a95a{UitoMlʝ|V ےkJ܊mvqu{WmܰkOG 7%*szsٝ7hMt~sٝGnGvX\ef ] /Length 280 /Filter /FlateDecode >> stream x%GRBAgFT0bODAb,װ< Wн櫿zjf1""%GPʠ:* jpq8:@ !hV° [ ;=h_B'\ET"6D_m0q؛ *nf#0 0c*U U 009XT^J1gPʪ||Zygմ*Z[>>Y\ ܫ~eOɓ_{&u endstream endobj startxref 130882 %%EOF graph/inst/doc/graph.R0000644000175000017500000000671214136072217014464 0ustar nileshnilesh### R code from vignette source 'graph.Rnw' ################################################### ### code chunk number 1: g1 ################################################### library(graph) set.seed(123) g1 = randomEGraph(LETTERS[1:15], edges=100) g1 ################################################### ### code chunk number 2: simplefuns ################################################### nodes(g1) degree(g1) adj(g1, "A") acc(g1, c("E", "G")) ################################################### ### code chunk number 3: subG ################################################### sg1 = subGraph(c("A", "E", "F","L"), g1) boundary(sg1, g1) edges(sg1) edgeWeights(sg1) ################################################### ### code chunk number 4: example1 ################################################### V <- LETTERS[1:4] edL1 <- vector("list", length=4) names(edL1) <- V for(i in 1:4) edL1[[i]] <- list(edges=c(2,1,4,3)[i], weights=sqrt(i)) gR <- graphNEL(nodes=V, edgeL=edL1) edL2 <- vector("list", length=4) names(edL2) <- V for(i in 1:4) edL2[[i]] <- list(edges=c(2,1,2,1)[i], weights=sqrt(i)) gR2 <- graphNEL(nodes=V, edgeL=edL2, edgemode="directed") ################################################### ### code chunk number 5: addNodes ################################################### gX = addNode(c("E", "F"), gR) gX gX2 = addEdge(c("E", "F", "F"), c("A", "D", "E"), gX, c(1,2,3)) gX2 gR3 = combineNodes(c("A","B"), gR, "W") gR3 clearNode("A", gX) ################################################### ### code chunk number 6: combine ################################################### ##find the underlying graph ugraph(gR2) ################################################### ### code chunk number 7: unions ################################################### set.seed(123) gR3 <- randomGraph(LETTERS[1:4], M<-1:2, p=.5) x1 <- intersection(gR,gR3) x1 x2 <- union(gR,gR3) x2 x3 <- complement(gR) x3 ################################################### ### code chunk number 8: randomEGraph ################################################### set.seed(333) V = letters[1:12] g1 = randomEGraph(V, .1) g1 g2 = randomEGraph(V, edges=20) g2 ################################################### ### code chunk number 9: randomGraph ################################################### set.seed(23) V <- LETTERS[1:20] M <- 1:4 g1 <- randomGraph(V, M, .2) ################################################### ### code chunk number 10: randomNodeGraph ################################################### set.seed(123) c1 <- c(1,1,2,4) names(c1) <- letters[1:4] g1 <- randomNodeGraph(c1) ################################################### ### code chunk number 11: rGraph ################################################### g1 g1cc <- connComp(g1) g1cc g1.sub <- subGraph(g1cc[[1]], g1) g1.sub ################################################### ### code chunk number 12: dfs ################################################### DFS(gX2, "E") ################################################### ### code chunk number 13: clusterGraph ################################################### cG1 <- new("clusterGraph", clusters=list(a=c(1,2,3), b=c(4,5,6))) cG1 acc(cG1, c("1", "2")) ################################################### ### code chunk number 14: distanceGraph ################################################### set.seed(123) x <- rnorm(26) names(x) <- letters library(stats) d1 <- dist(x) g1 <- new("distGraph", Dist=d1) g1 graph/inst/doc/MultiGraphClass.pdf0000644000175000017500000037602314136072214016777 0ustar nileshnilesh%PDF-1.5 % 37 0 obj << /Length 2569 /Filter /FlateDecode >> stream xڥZKoϯD!V/I6 Af3@֋ @K]KxS~disGuUuWUMݧR]Gh敪jr+YNuk'}?wY@{4;@~Po}2DkUKL֟0E!F6i~=BFF7H{؟Leeδ|әIc Ĥb4l\e%fUa,7j&3KSP%s rJVb &:?lJHw Xm7LԪ -]ZJ@0hA5it }{wL0*݂XY:y F[y=sm 6eܵ<;%]1Tz8p{R~0q]?&{^'_hcβ*V8?x[S*kۖ >:-l,[p S˓f/4sV QK2w ܋_m&_^e,ZUF*6?Kjt-FBB;^zw4Ɍ-dXʨz p 3˳74bdIr,xh%<,#*,Lr؄i2NY;Lie7ҝ(u]msH[@1 nEqxM4ĝ03G=4h%tƄFd$?sĶ.oT)5 !r ȻzG$L>ZK :1AT/R0:|9}ʐFm2lIw#0\}" : |(o-SLWF-E#'weOŗ2k4!AG9rExwi SNa}$ p_O5~Os]ʤ<ݓcPc ¸λ J 1P2kGk\W(5<-h'b[:gc/ KUQ{|쏤!A9c̱cʄICsjHǗ<FieHmeֈ+ bV*Xݓʑ`H\{"86 KQs` mqvث ־%Z'֜.q3JlH"v7]kʻfvSƄ ]zR]y秗}A|a_QSn֡ϞZ( z5OO>c9dz42qq5Mj,ѵ7Vlc)q׳t[3ཀG1lI+M6? j+d $Łb!޻ h1؜C.湔.VlE]U +62NѼ<ba2Jx;.b3J~L:=W5XSXhWL_-!W.JUeBY 5´Bc_EX!ba7o|9SXBu*SGL"@3~tAj1XfT)mqA,Xi#FezS}qR3VW⍦FneoBnua)g;6@ O t{j8l%cfT1k@Ċ\6Q:DxiE07B]`8 z_ҊRl7(됊9 <ԩڥ7[2Yҝc%W^HHVV̥kg?R".R7ceβXiNTqħ{9SѾrR^ԍ!JwwWS6;%=rp21gk([ˊ 2*OΨ 8Tڌދ5Y};u7'}?c&A~ó'}:ϷWIތR^ΟKp3\f4W|50~[ oi_mxՔ$w]F^ ytC'4ne~ד˂'є;۞/ }qN~!F.ˉu|?H1Ƌx1缽DSD]9UE7&gWS~Qk2?.޸߭zgF L@2ñW9S{J?H-# kmȓ_!#bG}vIv1;=`5>+^z3Uf }h6E8< uu2,~arE3C1RVW^3kЉ~~6Uez.>('RPFx¨wu\( endstream endobj 50 0 obj << /Length 1427 /Filter /FlateDecode >> stream xX[o6~0>@ pdie3m\Gvg9MwnHdˀuHwH"UR:LoEA^IQzahlFjv @>UOӷ.إVIT>1ϗ 9+h/;;hhCo2{'_@,FTE[Qw mmWW㬕goL?nM_G_S}8A't 跳[d (XYd5L:mJNn+ ʗ*K, 0A_߉^Gcz4;A nx&;|bgZP3uF9Ha/0DxhDmpQG,)l@$%|Tv!bU%ifbσn/:6h S+rlʂ\+K  v_s.dGD㬏pMC)o?ts`' %.sɝ0A<e ԫ]!r'j 0;_l+n%qAm L"jP_&i=6`@K[̐W_hPZ6oY0WJɨy˟Ϙ67 !գ>–;0.[ސYe #Q3>$^x4f cUA<5'U~9£HBڈ.s|&R4DA* _ר{;mֲ1'8?Rt>wh;4 vyLl>@eodI*@9CN d%F|N%(za=r bȤ&)⍯6Y֞RJH*KTW FvnNRPT])Pco^K#KWZ`W7c!}, 8q9i8Ü[8[W#T _) 2:[$MM?p %|]}u%a_=+SUS,ës v>*GoU+QM[Y5qflxR} df1Φ$(o;²D!$s{ 3ƌn&4fhwDJQ:oh{3f%CإI[alz9 ;>lCG*3npӎ.ٱ&<u&3HWSCN2O\%' \ʲMq,DWN Ngt%;F#yc{#n7@Nr{@z!"0N*Qy2"t)iRz e* =y'Uf9tpC\WCV{ dG~Iw#<"²qPCh tI endstream endobj 54 0 obj << /Length 2536 /Filter /FlateDecode >> stream xڵɒ6򉪲h HVMʞ'IsIW%.Qg~6ܺՉsxx{Wo?ɝq殨T*.*}w%BGbRѧ2Mhm;0q\$Etillze.0~:LaRSggZಮ?WW+>u vZ/~+[2NKMTxGp5Ϥ߿.s "Ct;0?XدJH*Zհ_hw=11mHebӁXm N "!]DOgnē8YG vo^.jeiUFÁH,ŭGF(^,Ma2 HOX0"HaeO捝KM(<8q 8Lq\Lܥx>5aJeR(жwheVE."uhs"肅B"M  SWz ;Cd*` LbTc{YK2VzӤ٦ W,'{[fJY;:'pEi=jV7#U©- ?ocx̠AQdRURK8UE_Y,Жd.Oq1,u(HOTTJWC3> sOc)V`~-!Py/yVaQu~seOq%:2jƙܟ/ՍA*,Va|+꼍F)K{ AJ_)g/rt{GG3Oҷ#7cn'.6/ jM'a ]φۀn ?g@\k $&ן0O^&蹜C> IM`KT}:F=uV+КxgA. ٰL,NMTXe`lTO FQS"T @8dEf܃z{tb,:%}8 ݘfy/B.,# A*7-h~t.⤬fTzLoܞzgفWes\҅OKv9¿J\x[<~9슘 ŵvk`,_8@.߰p 1۾`K> stream xYoݿBٙ=6 =`7@ <ш\Kw^"Zf_ݾmqU23J[{K}ui\KWiag&v:Vun ?r+[uKjh6W'>+Bagtܿ; 0QO`!6/]fxFê9=^̓ tv`^6ovV@֪҅tIl8_Q: 𮻳glVxt+=2MBF66tg{훷^N噹JƍT߃ n=oJ*˝-O25`_GÊG׸79V6`3]ϵqs]\06Q6ͅ C _7"=&/[1;%ڀvwEL3ED gʂ#xh'}'RVa+BGCL 9圿rzylu)T#O *-${ ּG%h Ϊ ~I^+y3%&* vέO] IA"hkIaNܫBB}Il*4ERO CoEOY%qA [H Iu`my$ڵ,/0h:9y_IJmsNW(yy%A+Ad\npe3lg j7#:/lbpù$6-OyY|m09lkZpKyt}w^0Kaܓa(/"/+e,mf% #ݩW|%]N B_c\6kv L[w] ,T, Kc5򓌪o.U{9jɬR|CG-/{"^(\ gl2M}ǧ'uu蕘](pI+yvDduj?HdWnk;4Uy1Є25畾9zA0MT`'Eb'AaK흰^[l(㭴 z8IHy#To Kl+H)u:Yl.iفh5OJ-`C K[AYGhۏĴ0>w(B CBh> N|LP~cn5YMSllȲ^FGS9VxTn+5%$ѹƔd/vj@7h*!IIɎŪL1hrz#I7L%z8|Gֱp>T>c K8* U$ť~L&ҬU)ĸEc~n$ڠeppz-w$Qq}CI6ukH6,}؏pwx!o>dG-q"4!'^Gwccj@:F(# % (uB5t#_tFK2EC29sʯdc)^6DB¤rYSOy$Hk@Zh ǚOzub=>S5=>[!(aH]?vٲ-;奁:NŲJ#Iĉ<\ζvT5C]`rKc7CM1#KӖ:46Negjxζ~o 6T[ j9N&Qq.(\ 6 }k\;[d}Ȥl2p bps,9x" Nױ/3soeU,'S7O* %"CYiDM$T1s-TqD gyr s1\%iVթR Dt$Rf/Q:oGxLcq@U<+}e?Xb`P` "ѯWT煯c.=^~\Z::>)" ?ě˳tr P>3L6Ҍ4Rǒi!KbWS֥g?.O&wX[!C+4ض˭$?HO"߭+J'զ,׽xsX endstream endobj 62 0 obj << /Length 1589 /Filter /FlateDecode >> stream xYێ6}WAl4fě$m ri^A Akkaw8Jnm݇E͐3gfGţ/tbIE:YO2$5 ,V7Ogsq==F c;k!f~It0~?qRK?szݝ//.sxzL3u R9A5ȈȈw@$x O=Vd7|0.a\vK0L-'dtJtNLIRRRv*-z[w{xG^WwEQXlIUR k ޳N39w?W ] _ F5 #3ƳOT9$0 *F\QL8)%'bxK.;xʐd0haYyGwl<;ܑ&$W!h޹U3~/UDt[) Mk ؕӗysŌR[xlYX:BtuinA fK;6k TegV$Q:CRZj A#Õ w԰넖,˕\Z-3TBd]+rnW ݬF(2fLm-1K$,Ϲ~bWuRڮW)\2e9t•mo gRW.{pq'W,KjonG]SDU;^*Wަ53 k +,씘 ˛`klƒrDyJ",&t*hEi~q@8v6z;fD7EOg,Jzx1i)/-U!lҤH{j@O\gFGVSxohWA\R}tF;#gMoJ#Mn 1m89`}ck:F.$S Z$xUBl΂6^K2u׫w[_-pno5h]ky#Z]gxrZp;OpA7mˎZUS ߅PMꭨXf=+_#Po f*K2@A:Pe@cnf3 @5 .bjDbB)5˩脔áI{)AӲ. ؂ZW.UlR-/}bIg[+> byiJ8N܋,m3a4~e)iU5tEfX.soH=o}mSa.Ӝ ! `Rݴf-Nʏ:T cKl \p ]{=G{GL`+͎v tg>WQ &?O [nu tEmbڝKJh {~Q 3n{ƺ4+:/Z [1*$8OP6vHDʟ&OO_ P 4=gE2$p=zx7בb endstream endobj 67 0 obj << /Length 1719 /Filter /FlateDecode >> stream xYYoF~ϯ>Php% 4j1I-)GG񝙝=(j-rwvvff}~e1*RK=*Jty)FW͸PQ="ZGSxk33S[x]jFcYY1fp>kxnώM#.^\j,E%F֟͒Y-Q/ PL" 2fNwP*Vۿ!)W~;,ݶw5.DitS7a4c-D̲pwZFΓ=#s2.ikX#nf?q>3,H!8׍Q03?< g 8c.Hl]Mq /YA_$e1̉12׆hxrd N hh$$2NEi66C}"{irfFl*Nྩf2==_7>xfst1 "<>EM* =1ɈHkq 筳dlk[":d>h fw|Bfl`YuṶӍT8K =1vQ9ǯDY&UG6@ARƙs 8pz9A zvHjXzC}Io*6 MZ lZSpD.(&2Kc-* I&# ;^2C.ɒj9X$͊E:k.¬p^CC-GRȍyi~@_ ?⩟SS?ԯ)_B X6}Er6p$L(U?~p[GDFwNl:r;TìCb]AFS9QxüIwP00>j= $ u)5, gE=1ۗzdp'{YF(맩Mfo/yu#^v}[@x7Qq)iAnߣS6(A>T c 8kծ*AY{Gjau-M6 6*2qϔޒ]eՍqk#|RYtTTY#Quxb̢/-TiW)lS+@amG(rՎ!Ts:uck.On"Hjgli䨭U@ +sqtIVʙ噙髱rK2$M{ڰr7(7IDۥ#i-SVޜz捙jicf,΂.S&Jgfٜ?_ ޚ໻532/euT"ٸsEU3X_d w Cc\s3Il5Olo\9IA]Jf<.JyvPCcJ.8hߤa{ӫ,X xus@V8x9͞aaVaMLN;UpRRas1"Ƞ =- I/[ DqNukH_qYG ޣ*W{GOk8 wiD\E#ٳgG endstream endobj 71 0 obj << /Length 1764 /Filter /FlateDecode >> stream xY[o6~0=@XHuX7`um)k-Ò؏߹Q$E}LCѓ(nh2_LՓ(8U7J,ZM<&GAj^Os3xTُ0d!v Y}Wl)YsLn`+RA4]{(} .>*ww\KN֫sHj=o%͌Z8IvL!ɞMVn`vg(d̃)N0'MkJg0Zv*kW Y9j*xHrm5o~YiFN|yBO֝"7m: yA23VCfc A+'Ts(EÜ4n4k] b+m6^uI<$56˱. j_@W[4&|U0qoM//т/kC\}`8rHX &O"Wyq?Ar|`²L&G?AԶ@p̍S,D< ~10.$3dVmGnP.!@jd(*]~i~??MVB#NH3."y?yDPIomj(#e T0}\hB p5 ]C@, w+8ACc Xշm,Nu‘;T@U䨥$Z+LQ@4F~D+k ΉI`8oZjsTǴCR"qkC.8hRDT}w7anh20w6=3uD])q'I&_čIIY 8]u#*`@JS ,MaF676QOC:⑕CfF=y\VܚSFuM'[Z?t:8) DK/moF] n-a:I~k9N%Yi1v 3j|K#ΓAJ5 0HleH sX" 3)%5QEUA{E$K:e ~&^ۗYvknx+9e$%wغ'%WF*1(-R6$]p1pgq$l6;jH=6taI/<'A~cnE]E Df}apG] 3oe!&\ U#Q~lVԄT){4K4Ko@N[ٖPr5rs4`e.yZٟ]v縲trC8i];B?@ <0/Q}R|-l[MEDԲ%e*5:\t|&b\ڧ[{t&v +84ޝb%w&0v=⮛׏{ *򧜿dI:sc=| * <>P@EB%&}XʇXmD-72||;iWð @nKA`YaĤ S }W7uoL5}T\o- h]ؽPyڝ˭_RG/!<8E/3$ o){ endstream endobj 76 0 obj << /Length 2093 /Filter /FlateDecode >> stream xiDֈԩe[Z3Ziŝ@Vi'NH:^Q͋WohT㴻/\U|zS藛oNJuq3`nTdW}+0JkB=N5jJa'@Wh\jCCr<ڨ3y߿yAy ˿D;mϵMkV.~6՛R_0(ZJ1ЌEa =|ghlζqHپ%x6k4Opqd2 8\$lJx[5[k2Fo``RtEL-#@쫲Wkؙʎȟ6n/BWsvAjɦ89/ BDRڝ`6~Tݡ{>aoHh]Y nEl @G|'Hr&^[G2/D=1VBOYEfdcCve+hoLgC:2$A?K^ea4#ԸF3\#~:;ÍFfa f`i_t/.aϸ6:#BLJ7Yz\E!,]Ɨlǫw#an&HR2wdtWҠ'L")1lŠ"1}os/ 2>EF˃i23 :&XgdROCvYaEg"C+z.T3iK=('eV:p1a+WY1pȢcӔ U {MvbT(3$6FXIv  O\Bۅ}xqf이)DSn kTiF> wNF>ՔuF`@C'K C qc_";g#xaUcm'~ՖR-T!PPt$3b}N9蛤~G-,)pt+ߥEB/ OWLK1N~2~#/eC(]?ºPy,pQR$7r`Ib)}|3J\u'y,j龢r3 J gG5X 2y6FpSP5lElnr4|V\~; nk䷠m)AQ̀;YqŊ;bAVìV:8L+o8+͟g GR |cE4ޓYi dVi=FAVڡqVu†7ǍP6>.Hܸ]?L!b/K'{(NC)e UPvVUds70 ԨiW]dmxk )J]WpG(=؞ƚXˤÂI;]y֜AY\ro+} VOj5`۾ӮW-O[:XmePkr&4#jbm`YE ,3Hp΅7-O]9[6}J=&;D%4$&6D=$aGTX~GNJZC†wG9_|b=?"-odݙG_Rw#O5@I+Q_Q5,o*P :'w&LSTJס/o;b/21 Ld'lU=Jx .s<ߓs402q*Y*19dBfmk<{>0Á(nGN M|w5ao!9LcW_TG4v%A.)35,q#ֿ # '%Y&eֽ@z$ ݮ'sfӓk|;Lm`׿aE'c;iȦɓλ^C?n_xJv)X_;'\ҳ?^G:⅀RwkiVg΢viB(*2P-]BZ^\ݼ?L ' endstream endobj 80 0 obj << /Length 2030 /Filter /FlateDecode >> stream xˎ6E!*R%mHM9A6XryQ,5C{g׏~|a",6W׷WyD]" B]]/LKhw>@5Ъ\U /hgؘ,P7"hj+ @+iʐo`u53h F0H!i`WlZA9sXY[v@P皑2:npq1 _>QK!r_=֌,n*byj'] = O$aŸJ618ȹ"cGbS?BAcm/ Y9"Ơ,v$)D52s,*T:LS|-r#u}/J Œub.ษ6V-ϔP= ^XYZ^U;&-TVQ_uT lx#JN4!k`NF*ɲ/n sƌs5A;M%a$} NG;a$/y%UnxkO a-?ݶxuh|8bzl%JޭF vH[ܗNG-j,xup[c6* WRdaMQA>"w,j6ց-e 4=)*4lbLJ0, [w ?!Ul2Jd{@6č&,:6zSK@cղ*]+'NG~ Z]w@7䐭e@*݉o 9HKG*q1.^c i5G2xŽS\%)HohI~I ;nlSWж~c%WQ.c&,ʆ9܊իsW3itV24W4ty{JM%{b7eij+I!׸R5\^ [zYx=t } nYQ,`Eٖ2א,<^"zdGȼy|hwq֍bvwЕ &H,vl0ƾySLI<^ ˹6D)T1T=r#Q*# |"D-of7sx+Ofijf0Cs1٨i=)d-٤ҏfcf~\Œe8+xQJ җZH#ap'q2XŽCSBXDK7sĆ;I4@NZ􆷲 )PP]Xߟ" UaruQtO s&v(8Wߕ! )+_p7)1ʽQ6 %;?J~}_$ia*_^p M**OR]D_i?kR60M+7 O O{y\XM 6 endstream endobj 84 0 obj << /Length 1103 /Filter /FlateDecode >> stream xW[oD~﯈ɑYό @E !$ 6N[NZ-s{8aBé33g|~M-JUf&[6TfKX?F-cgl,ujw@^d#V{g'[af^R[ [v@oXfO` ~ W_/E*K^@nH4P"dR!πr WA1+Jdz=ҭ"6yň:g^d)ZSU"6 ]+7Kf•9b( \ps( /i+"(mDM4y‹Yc=I'C$ j=V͑f z;Y>18>Syk*O4^KDMՉb{,RRҸ+yrkk]c6p{WVUJF zwS!SHF`/<sXegP[ v?n2je 2NSDBHwՌ2F9Öu gb!rr^G_KZTT‹-'=$m$q{cqu@}2lNu#9)B)J>.{rvQ ɉJ#nsBK%+8عqq+,Q:s'6 :@+Ȓ<"I|wPt`7[A{Ym1 }_;y>L Q+"w||PEI8qcN8TD|Զ<9Cw>_SA"Y1[=i+pt-T64 |cÄJaIG?tc~h)ϙ=UYZ1;g,oaJ/Y{{( 7b[9k? endstream endobj 86 0 obj << /Length 122 /Filter /FlateDecode >> stream x-ɱA($ \vTSHB $:@\#Q_TQUE&MG-nu8M [Yð,ΐV]'v=WN;S3uz3x:cE_ endstream endobj 97 0 obj << /Length1 1841 /Length2 11281 /Length3 0 /Length 12428 /Filter /FlateDecode >> stream xڍPZ.C Z -^ܡPܡ;ˑ=Lkg 5%(qpefgaH*I8Y8P5A`bjm  /IgLN Pp9<ll6618 A%B- qrY۸#΂;@ 0s(_3Z B ٸ: zxxٻ@E W:0@Wg,(M_r 3*,.n@gkr"@_Lg`gaOrbhrX@"+C3 635r3sp9G)K;XJB.('rZ݋sx8 @V4aȪrrKm*BGf tpN 5*vqX6Y_P|\܁Wg7ϿP W9OW1/z O+l|s2z%˪'.$-WIH@<><fn6;kz׃Q5]ƿ| }T7^zRll_TD$SQك^u kMu-lufk ` A.2 O*/%c *ǣ`fgc_Ų{}8\^ 7Rbǂqp̜ͼP^q|_7',Wks~+3 `CJAV'U `U{iA|Vk?g|Z f |M |k|]V׼@W_:Q:>`?R?:R._ w|-_auqS+/X]= rx?U'/X9Zr4 @YX~ i'`ɠgYpJ9;hF B;>YFvv?G}4cX6K]`sf;oL!(G#J&K!>)5į4yҘ5\Ő )>8T0 g(vPuyXd9-&4dH>V5C&9$ gJR$]hKoﺎN:Y1e'5.Ѿ`ktK, Z===/@ M Hٚ7q WԾ{ю=g+bUqe@[-%Z8iIv`7BM{N Jޝ}rk~b\|ΣYSZ~ߴ hv'ƸMTڵ{j"ea93s=ƨ,N}vӁ2OXf5 |m"h7eV1ĔS+ 9 RűA=3E䎭[SlV:bN#*`NݼQ6fJ`Ÿ6wLs7;:iP@ By07N W1F4, @Oc2}IP({),ߛK20pnQ+zi\X7{ܥK<7G Q_A#CJI+cmǧ#|RAn;5ތ_,[{x/Q0N@ԯZ-e~[3NHۀi܅XF:Nԙۦ, \S$}R$JH $&/®HUGZ)SVZF ,Ȱi'F`zS!'+79XƲ|{Ȟ55:oUVN>cH!lڠwZ8~2%B TCX٨ EԹmE3c s +v a]ùu_-7<DZy Rlvڹ .1g+`MJBHkhƅv|rFNpPmNBg_j*Mj(dD{X~qBO>hs2~2D1ܰ=#fa(Kg_HHs ~i!Po۹ϛdNۮj`@ !HH^%Q1/nR a9ig&F;7Q_la`p}(߲ N3ˉ%6S)7 Ešvڳ5_ Kм!_N-APTx3 1 ` ԜN5- aj-oXUǿg\gF\n֗>ҕ7z1Wshop ^~L87`٣M!tybJ{4g"u0y+EցhJkpmceRp`cmf_XDH!-3owJt/Q2v]`DZIЉe-d:c]s%eOR<(ɪba掁avbxs^؟0GXz+RY}|_!Z1~w/_la8)GiUľ#Z1|94@ 4QVS*Ud@[;{ɧ㷿zuqQ J{D҄@?_n ɆJső7Nza<#T6UQ sCrL{m(]9vutu*~$`|ɳZ"8X YA_kȵp*$cFa=`qٺ(ͷ(~JL@9D}JDz'4 5XbUkNܴFJ Кxr+y 48Q}3+6DhD{'/)[a;=Qh`pְ5~ʏ&/: B]6Ӌ镲ݍ!r|qH2(k!89gS7igb){Xӣ?;D%H~M7r.q$DT?E@OI4-;Uj^mNϲ/hnjEz⽕tU9P~ W|BVy>"Bp}ӎp!9 Fj)|+|O#8ibJa3{} y3XMF?) TTh"l9U+]'a)0O0+ng|io6Kd%(C_+l){ʛ{[._[5&‡[m tXʔn { roH4BN?;#Q@\ݵh$#BD'KLYUwƞEP8jEFD22>Rŷ>)Gm"ixZYQ7=t,'Z %-Blu ݥtJ|SToIoa:9@c_DDjЀeoYLnJ?xJVG'Kl4 X/8h-#0->}wc&6ªExi Xۓ=hIn0 $ԋ4~a?5_̡<F }NJs2 D {fek!QĖ#5\, ~M>Oڏ ul_@,u 7GU y+|bxp*[ydcɐ!GGʸk)ݳiW/𮮉¤!u=GbܶlMܺ7z:=4GMBPEJ?苼> tcP8_ZP+ЊLpA2Glsy(3\˯f5AlWN |{ af| qc<^=qIL9΅:%KۍNvq!-Җܞ0Bx_1.u|o*u H&m)ζx` R3G Ls~?ϵV>=;. %M+0 1ko<_'ڞI0%hvk{TBʦPVb|+L?W v8-a!`!p]j)$6@1+t 6O]fں$N:T;VʲI젘0W +%61&6E6*4bºj> ~mUN404d@GBE~xYT34um,/&HAn~ 2;ZҦ^BZs!|v7B/r9=pFv_|1j)Z:ɿ"fQ]FaPEsNOs-e F`vߪTMx8mX?9(%Obwf][zܧq1tt*~z7ސǴbbr'T3ܷ"jK9򡩴;.xtb-n[#"& gUX=f}hGxduJ^%=@5x~DZܥ̆ )zẻ' cxQcr *daLЖ.ZcXHZ tIlRw`$7^t5ם].:~+-3am/?y> ^ƁI3dD+Û~,v̴:l akR'CI Oԙ%*Y 3 wүu}3ʔ'{ܔĆXs|gG OٓTDP DOyCY+od]26otҥuj%o'/U6]$TT.c]ŨE\bɄ*ِ[~pQlxg$k8 ~PUh}icH YL#U XLhTQQo&pJ = T&eZNʫ}/moZX,>F:x؏ɳ؇c澍)~[iaJoPEXe"` m8ыFE"-[Q-j| oR)IZ;4*Nlh?S^ މeHI4wlV@%M7sթV~ rߴ~fDmKzHjUE vKZa U-UΤ vS>I L_}8|P]6.!>G1/B5YՀJ",b3w#sm$Y_7ACaRIsS!$d޴~Њ>Z"/PRKi[̆"M"\|Ւ5`1լ[ГL]T({SU$։>'(h7\]͂EƠ=bR< O1(X@k;k 똟 ;4 C vCd D||LDW(x 2hf&?5r*Q]ov&7/$7<MM6U{DOdYxM\ "c/R:0%+AoT-,dzPct{ɶ}kU ׎4Ͽ|v 40 "̒PEa= Y{ރU;h9:]/w =ӎ`+w@)mq2l}+\淝d][٢#\jc?xMuQ'¦I4n0ZM8X_Q n S!{@*4;,1b]tJ{Ǒn8J7qJJ3{jDgv dτXs# RCR/NJ.J):Ruog!DG%bXh:lm2=4t#4߿aFo~;ʌ5 cYvuYdV>OF^y>[2 RƟ,дM) =uO.֋MM%9ߏ[HKખHUyv>cVMm0{!OFep7 Gģp )Pșa]Ag6EIS]L>)RݕKh᠂*o'QF[y~N`_S=I[lRT.5佴bJ CDwjDLe|T uPs:jC9v&f<^_+ FnBuXP(0#-8ΨOA\3&¤˴8"$h+NhKa]z9{@r?T ;#ݫ?amB)ǣuF`XA+3!c`=Y@C12J#FU:Z&*,'o"XJBZ:!*vD9}@|]9 ާ7p ؙO+;6˩1)/FepZCeV,JLވ|ey}7} BަhOk\ el9_-1cxr\8Ji60:cLk -|qs)%൸@+~fE{/ws,i-\.MUC㛌oM2حj˫R՝<;5i6v54?W d1jl^ա,-_AmW)LKsYn#$oaip@ H|xgXö9f~& &{Gq9,E`ѩ$4&hU`TJMF4F>G⭃!KwZɃ !#r k= /"P|-ȯ_@l0`MT[b(&1# Qx)B%*qo#w4Ȝdv*ʮn=8,rdZg!E{fH셀02x{ O/u"ybi2;4O?Mr|y"uͅSvNt. @5[N{Ch]І1^¢ihEolUk3Dܞn]2>#ى4D!&2 Rd qCDmگTq^t8Z.Af?SOsd+mȉg _]qgս &jt`ƻ5VT9 l\YFߤR3MHZ߷$w]S hU izn. pa˟Dݰ ̾67y> 㢪g:>($)8 4Q t~xB?4'z1 ;IGl$ |Mq?s|lx7wHxX?aݳԪt;^M*RQHSOTfbH׼xϲ(~k>l xXJ\3(4RX?e,,y:5js%`afco[>֕oG(J*vBp-L!_.x9%i MJ.'E`{wRusKmXm?1vD8@Ek f:8wWl̫݉d]We]= Ħr$3Phм:HI:՜w klt*P-. ] x7TY~4:-?j wbે.xg8S\}ZN^~k#Ԃ44b+gX-h3D2/D*yHA$pqs,BXC<:IH_x\CR5ӓpeێi_R'OPƿJ6M,5@ӀEJaZBv2gR,GT~Tۑ9Qk?IJft >lE2pϝ['Iv0J(]UTf;7B[PmXH. VvÀ2ң fpwBa|+tɈ.K?&cqN.| j|վ4j7A7#Zg+(41"7)l;(Aj5gS Vw~! Ք9`-#[@{l8TUtu5GO&ZwR!lXUg15XT+LSSDS)َoDD:>_2?onJtDܮBEijO:vCskk0@;Ox@P6=rH?Nq 6{Ⱥf!BG"IHzlk^ރN0;/済 Ծ8?XMyrNfyLglu|$ E,x3-%$^pȟD'* dW8 g,4:'Iy"A GrJ&jyJ7>%*_0-Ť˗-%G MHl4DCnKe{N3(Yٖ3k&O{3S> stream xڌP\-;. ݃- n=o$s꽢 jYݽv} 'W01X;330qdLL LL,pfUf6\mq26I'K3+#mfF5\|PR99?+ `73Է;+[l ̀nEAch o`cobh P:흁FdLGP65sǮdco, NF@{{q4@hO?tk`f`ݿY+YV`lf ȉJ38:~[:ؼ;Ys}@}`hof`f{D4*X XY~'lf4|ݍ񟓵q70662=-PB!&?6##'+h2Wv>-}13h`df0Ya7oo dz=f|~_/#kK?:_FAyI9Y&OPAgag0^F^m+amlwc/տ/5࿹dm޷ZLL￘W_)!Q'K,N@XP5?VhddA?29 Mٖ*o5P?{ZOJ|9]Rca;bx0E#뿖`mx `lcD9M ->OF?( (1  `{u?轺^]z.SzTS9w/A>?g3bXX~[>KF@ьl,-x =nd  ;owM .)w_0 i|/._=}ndrcNffm 4&%2{׶ϐ_tJ9w!lF R]?SF@cwxS}NK}ӿ(Sdt4%9|/_+|w w&w?1t__ }@CyC@*<q=oKNRWo |F^_&z8iiIPh}|֍Sk[?#ŧW|To!Im|.ڽKkm_h~%s4}JY9l(GzKWٛԬ7"8Z8(M92eN2 l) $IEf,DUzdCJ3ƞjѥ쯀@J~݄Ft]{9V4jV aZۭjy22t`Qķnmh.8~qxK;_ 3f WA2dXPngH LL {@Gٳ=F{_vl΢,XjpȾH1eKI YT0^nc2Io/ +`[ w3c8W-WieS =; 5:ܾ--8Q},w R֡ "&Vx3k@z,Ll3YBW"!LNY$'u⹤(\ЃSˏvR.wOMN>ԨWOI>}gazlxdjò\;[o=22xa7z*28i]En:mq:8 !H ʄyT_L.]@6iH[U~TʫթJ!r ;5kU,Gz/5g׬|>1xa NZ33N5qqC9Jh"9ā\(($* zk$A$K@(z<>BrTÑNLv͋%\G0]0q!eOqJYg3~0 ?AT zduQ>dzQ~ S__U7w1^w4Rk'Wy69k^lj{qe$Dn&/{)'#֧T!HT:q[7lWoCBr _}696gb4;ܪg}\ +,ug y}P* +xbêuذ~Xf;! Շp)9  y22˧Dz&MNYP.  IA{ȝ(N LK/S|Jv,Mj+M!b_7b {ʡ>|cv6€4/$9=oT ./Z5 gZIzݛh|ӓaN./’E*@$(͸SyΎV")qa]1 OEڲZ*&H'Ex^e,]]K0W)Ox]d5WvD]7j;}L"~9 џD n);H22 b}/kVeo->P%$ݒ+1j^ԱJ+f8t9~/Q10 [EK3ۥ!|]! u5ǿ` \RȮDTq~۾.&<6%8a ԣ*cqo;O㨌aVek2ҔDVs{+br/洍|@Dc4kt0'8$WwDtQJ^9[\_%IEWƲtyqa\܈˃>3Vը7sNh A,(:{\ tyA>CuSp6ٮLQqP՘E]'g7&VqQn7(S$ڤm3Rn90ԅʅ{KI>LZȆFHUfpu&X>RA/F^ronu?Ɨ#?oд|C D+w,A R=5l%PH-oݞB !+m'bem\<Ոr )'D<_V{M,8tHl$2@H!P[ `asA-t'eQ@qY ?4x#+BSE^c,s+T JRڍ'JSj3PGpk'D\+"1V1eTӾ yPLVPq" n\TE$5rF*sI<38Ҧ#y[Rzf^lq j#u垟_}f7RuKJ`P%dL•xHo\Xw[{cIWiì6y<:o_Ho%bFfo%vZc&n& ݀#mXH(AGp ~6Aml4&$K4fﴺO CI nED[5!YXg`nBz™˷KZ 6qY"' 捻3( ,Fp,()Ù1\4amXdC_3^ޕW<(Z{EpYUL&=sxʙ!=gg/ &T]1>8~֬4 EHƩ́NhVAmVs K?1J퓐uZu v=8 BK#Z'E$Ac{gbpGVMI _r{V*>'ZP - nx/bV¡Diu6?Fw- boXQ.HPlD䉵ó^usbN `M[赛.ۍtgRϓg&)J&,~9SOCRce YY\O*hdsR{ ]0E<xTfV}h& Gа@)WpiTBW @z=ӂbaTS!XڴD~[M #.V<7M  Q<1E w>'qHX<$yu5 n|ee΄ErŲe/7ER%)rj0xjW=Mq/wG_I" -l /C_kGZ\ͭm -z!q%d|FRHXqJ,5&(xrb97h"݇Ð+m&5~ګpdK%H+B|~)\u0㊴ gɚLJJK>b눯è>KOQ =_H}w%垯r(kqizǘQ*50]iX̴!Z>umrl2T'=Ӄml쑦 l vw,[xXnUNפ4Ц&ٵ7]A|ϧ)ֱ`-EI<yY_d~=8>YpJ|oW>6DTE{ qd ꄕ0+K?[aPQyods8kpQHW+ƿLPޞկ<(0xo-/>Qދ2dMvtj[1(V냁Z!D@RcG&ۗS`'s I1yћ@9ܵF,F_ӥpiq #*J(z1{Wj'GE.X'?vaU ׈-h mghd!Qh7"9= ]0*u $1{4;&OSvPҾ9 W)(**j~Q(a0*'>XH>:Xj&w\jeWmRBlB X 0y=pG@&Oat50^tjgUރݥ`)DЗbz na"c2[^F9[ͪ8#PAvLl&P$CJ97΍ޮkv=3B0hAc\ɂB$_3+j5}AuVF.-Ex {!R=Z_H'Rahux$pFtEZ g#51vz&-?Je})CEƥbbqB Bd_rU(b)NcEh{_YyRm:o^(|4; O}ގga{_6DŽ^zl~TZz{Nae//Ofc!<͘u)FKţN<2@}30BV-Fb*6F"` $z+E-9Z\jE /ʢ]-ܖ½L.q?˻ܡ C8ҋ^t|5;ضG+e|q4WF # EwAk!;` {$sŵ)u=kdTv*Z_u9D!`pMrp0MrD}^֜B30OsMm\HlpLagY\'%Um+20WMZc f֓rGcl,J VN ri}%X ,5d}0ʄl}9Gޯn#4dB2 )q%e#rn]6BV|ꌖۛ(],M%&MC8tG=So-cv+ %&Pj0̶JsJoXf3d1C8 7֟O!Q (,Qo\BJ<[o~0ȓT} TX ,\M(e^RWԧn( uʳZ#`BEo`(g[eB@`g /ͽQu. >Ksn u0yYPmq.FU=sgH&sYlaۊƒ*bgW|SŒfVm(plE!s)JDMCA 0AܳQ}K UFnšl@=~WpٶZ vFX ip@5yH [ ;"S5ElXi㆔ 7Y\j;&dPc2˵Q.˒HY ..-zȧ6:Qa,"oGH-6̠ f;OUc"SWXHSAҹF,nкxz粰,$G1GW>5|X{ 2RG-A9!}Ep~\n+-狸svG2^)@o Vk?-C% 4kWo$^IƴSΤ]N@}f^AKm>W cRHZQýur{;427L фas ҙJ)$[k5:m B{-+7+Z=9&盱zsO$؝.ѳ#S2o};9kYNJƮCc'2EIҰ 'ںhuIr 8FhcB8{}I,-Âi,yR).`C)]!f#o)1 mggdӐ{|WA2=]mLmA0ӦWp-A"dg XVVxĸn/}잸,Ƶ^P1(U#BV9Zj/*|tTf l OAB0P;ޛSK z\@>SD.̄qm&dv#)]sK6Ut7S4Xg3j؏v3(YXT;"IT_ Hd^ C+2 fK^;f~TJIJ_|V9/{UЀD~lYn-,@Y:;l +-P>z;LX#]U93fXNc-Pn7_-.=ۤIѝ$^λ0nv`PÚ'S|WpTc/N,qdDO#تDz>rѳbu]ٚE%<tu_wIr2(/ hhRωż \=zT b6ڇt`p=Yf]UO=|h,nԘbDlmMEfOȕ{}ˊ֊S>75ޢj42 QڤVkNY Yx[{8i8^DAoqG K)'!5Z5{/Z44įS_xzvdJƟ5_fV !vx/JyY@}Z8J:~2]]Z`R bWDOƟ{8,ŵhΧkBgݕ; z/9/਋U4׼F 2f35n# sI񳡖7$Q:Io7El X=$4b%e: E,j?Ȗ.zHh4Ԥ`j4cT.WU]u~kl/&3.(a ߈HkEC)N2}&Eşn6$B}[hDJ>DqkuuZD~}O{"A;Z6nN)s.v os)L.־܀'U+ksVcq&e+uۓ OuʜSV:d_}I!ZOi_KgȘ((3(+)k/0)0q)ṭm J#_ǭ*ޡ]]^}8R{KPRePq+ث__PvaO};v2mJI:Yp C18f^0ܝ4:?#uU˫ZEݜO=^ k@%* yH xn2Ga an )_$w%5'D~1ᙶi9^]o[N*WY{uGB# ZT̈fc&T=njV$N|b[-g>e!9coVg &Yܹ\#tqnseU F.V+}5=ːoO8KэgU݆ :y2a9i\})`N XLR$=J,Mi<_x+) N毐KP\ʘȲ|׆ɪ举[{ye%W;C3n( 1Ԃ0ciהk2pdXܠm2YZ(UA 7Ȑ8nP_^~Dzq`Aյ9ф6T/:r̷WrLDŬE4Z#uaqa[}1|.eЬRKtSQ mXk ̟ǴNq9lɕ83TdL11g?MbmgwjV68*)grLITm9_8%$Ř엎T$/ZvyB#9aw7;V`d\Ŀȿ3i]U !{FGcF-)|i8Pt1BˋOL&<+U;ỵg{ZE 0R6jb]1 f+[/vP^hJv<*ږ0&7k˵ѓԲ({ɐn%ܛYe ',݄,2BސE"Qcd8&Tm]+aN5w)Ռ|RBl¥)gA1* fW^WT|q~t Aވy5 ENgR7VJLwFrv'SP#QrOSl(хD s1EZvެY5ڙXʍ4'̝TrԔ $b&hu=Foj?鮙C"a2ڟIq5j:R=.A` |m8u#:Lg6wX'֍x.*821l=,V (;Q,fCe^~\bCX[yQcAQm <QfU0@p}SKA˃Ƨ[|r0d)`&ۃ8״X6IǞbhZ_WXÚ=~KPW#εEѦyQZMeO:%ܦMD4mξqM}?͐RyTT|Eq_ Xm{(LCl3EIFT9Hb_ikƇ0OG I\dm=hM:Wd,c7@ҲLâ)SV%\O,bv5 ~&~e$z~zO_I8jɑM4oI^ycΫ̎pq_ 4*+??ٖ((0@Wľr ) (F5ܿA5K"SޖɢI9GxdY1f59tM>vWM wB M|,Sނ>5GNS< ~i䬤2LDlw{E8̈Zg#d}QOŦ ktP'TCUfQ(Ds !QՏTE" ,YM'}vhB$.{FO+^Vk)9!PDG˰zۖ:8HM` ےYbH`^vAۃ]! If})B`@*eKbH|6&\xJ؁0@(Ī_ N3pĒ> Lk֭Te@uό juj<]]MmEg@:-TQhdi%;xP?"0>ȠxCH?XjSt(|w"aj=5> Դ^)9R^T,KUڛaG27}.^A 'ږd7V4Ty;:ng3U\\mLFzBq_ G{Z]W8*>Fw ^%yywtz U4<AKL>UMo!$c#@8 t+>G]g|DT|x -.eʆkas(j/G9& PpBs_σNzMД;YI~F?7%Դۤ臗 l;D^ؿ/QC`"h`CI ,,lr3 N`0@ҭ>8zz=ͫ=1 T8/.$k-vn*!`H\ L>`mY%%\TX6lt$!t8uXBݸ PѾNճBY>+)kF!K3!(/D%d+kpH&,42X/̝-σ.&,#Ap +F?kti(n_RB[iXW6 /ZcȐUm~d\ɷBeg<"%T Cr=jĉoVnWsk%lYu^tRJve _ԍ(@bqí1:5$1A,S ?>s+YMYVVc@(ف.dfoQ5ۢ'f7ZYOv6bl 1Yf{TP+S9V~G33=EƸSlf j?#,I$uqOp#q6\p-zM&qqSo1pʅbpCb' Ia"7_f~+~`6dCX$]< q)Z8fz= &)Ddn`i[ 7I5#=I`Vn~9ԭ&'H 8iZ o:Np ~Ta}'~0m/Dq?n3>|Y. Y+*48F-ѼoZ!m~2£SvK52x6J~mO6r PLedh/M :+J"ǥj* cfݼF!}&X~!bS\&?pĽ.OǦ <78s="gs+zCSQ;$'[IY [Yvjĭ1awhgo.hBI1c}d-/UBࡵ)H5' 6:֣H<3Q~ %ڰ혤e yxI1%SN_}~EL[DɫNy# MYWBwB{@b` i$k,t0oEPkf:<&,uIyPݫֆnE/z|SEQ@")^TBy#Y0,bV|:]{+> V]AE72ߏ̗6,K.92ᚨӡ*Gi;E@Y(f!c~ڛ#Zc y:H8WY)$ϞacaCӆVkgj@so6‡uzQuq¡9d*V#Aהi(;(d#?yў j=Vնp<7SB.R=T'!>F?7p ILfê:z9KZ;(ʐЎ о(:' yhoKau"W&gcjCLcpM^4bt|] OllSwc =]3 Al9<,ঠ窛! '̄ӿF.}5DFR5g,hJ!moݲ|8:7=Teu%mkzB /ք(ҢO^}˶B4Q=O+T [##eH֥t.?ke Q*mlAK+OُE@ŦTI hלw[In{t#bG;L*{b`gͳ]XRdD/34V~L'"L )םcQ_3`;DI3l-(d.~dƺO4O 9jU^fU^i]"v#B;'yՔ 5פּ.Ib/b<5y+,vPיhMO"GAc[Fb8Zug{uf96" evK7-j'ei^[6ل>a Neky5H q뒩&֤+2#3^L^yև'}Ou:`$i2:ty4=+xGg[fG2)u}k:.މZ'GtxkNa'mNtJrRY60njKJEyƽڭv[v+^R#4:Z-7 {br4@lwV-Q ax%]0I?c4_NS4Yb4w}DrQ5^xWt_XqkGmabc].9J$&{c93#z yC1o3bh=-pPD~e u9\I06l,x %B1 ̧2a+m2/&2sZVͭ^FjEXXl@-^Y 8l`oFux1hEx@*SNXҺ4k1\i.چe Wr6.Nzj>;DEZ\:ꃤS_7URp\F9@ C-~ @kX]-@lQ4{ceHzE]q`}F^;lOGŋ272/ZJ>L"˂,?^™ܰOė1Q͗9LZ񽗬y"6 1I6=~.(L S0aE/ \!"SyS7TIMc^~7p秵{,q@YQޓu+{ۓ Zfn(r_hX%{rhdYb=WXۇtvf:z52LV|ӌᒨ}H/ -L rF:孋#CA+u*3h @o0XL$W@.x|;F袭҆ &sȎ 9馹4roN(V&c{-c"9+YX9nIh١|:g}VOT%V` J,bDYkMCl;qì$Ќrf[+L!c9$,S/FnXYEwv׵uHW IUVSUp;0ӕ5*!S kBGLPL$Ph:㒤R`X[ +i=1>t\eDdAO Q4KY$"vezU2y־WHMp0뢇TvChs@_5J_AX;A+9ZR9r LWeaKvLtK[qC!ZM=mR" ˖K%[V8]=m ߡ+‰Y|$We DH Y]%,w 4<cxxY#>{f?g5R8.9a¡kzmKV/-s]$Vj{5)>@̫`LKuNa2~Eo_ݡjnƈ8@/ƓMh܋UN}VB@c C 7"`u6a`I91.c'Ƙas| 3LJs;Xc.v?)x lZZ2+c'9Eu|J*3bx._[0ED5fjFnvWNk̹O{hR^]%)Yzx쫐o&AS[O|T7_!+"j\t7A,Dݭ1},X+ڻ*݁,"ޯcWd,Y%9]RFJ]X=ŝza:K+wEaj[PDbNƱĖz;HA2\B#G۵8q;ԜKU %0+.E4c,0~N蘄DHIwW E7PoxN G%Hj!œ5^> stream xڍT6LHKIˠt%P0ݝHtw74 ݍ (s9_֬53Ϯ}KO.efg ;sq* .nrckmu\_i`;>T%'_K@pB!!2`g@d:`Kٻ!`eap "`0v>TmvR0Z:: srpm8l%u"fT?'hYkڙ;P"fP8@SQfIVl\\+w"`0bgks &~6v`g0l@s0@NJ~ <,L wtݟ <7k s{ap3C9sjao2QLX,> ( @]!kCpr6?Laog03>`y8GߎFX\\3` `.sA^fvp/{ ` ΢PE@fN? ;uL3s= `Go|@,7oCrN66`[_:9>_a KՅ*P3z{ ar0W:bXk^2nع=lpxP.wIY8q $n>>*A]0nx `n}\Nߦ? S$T 8? >\N_ |d/Pp2S_nn?n :;1zA >7{p:뭓 zwyޒmJWw%o M3=Gwd~Bx?}y5E9vOˊuɓu}L#9>5%˽D%YUpҗ#lܷUAgF cLdĊ"V[l iy3NV]M`j6| lZ= &,! KZx7_5rf-^hE]$ʛ~2q},usEzd& $ͮsg̖9_l%!S j+fJ4 Y<Ɔ5i{.XC{nhKUg a*`DG48=_Y! YW s[|0(QbG=(>J#n_…ZX<= !%3l~mC!o%$hb|ݽg?( F3(B?~h3}ܒ3.?M*d~ႏ+%s3eϬ-noÙ$A|}ިHX7TBcΧEy4'p:KQfHeywIO)ȕwn*I:|O&U(/T w*4G?է,}_r)P3vXkptj=}|\L[RfWhn~{K0뱻'G?-NUJ޴b>I-$uL{ =P ^t' ,}HfxƋң3͜+"VH}NQ=,(250t)ٲDI\8B[ñTÄ́Vc zT>}Xk@Dk%pWرhw̢[Ȼr|qFĝĐ1!CŜfg̗  NIVuBxoڕxʦ҇ZLɥ!=eĩab?܎#.Iߟ42Έm-ED1ki5D R,ùtK4 T2_M$RP75C ZH n "E xxff|ǫY:Fi/D X߳GS},[L~wX,Y矴LG3_όyF}aӦIϬ߄g{2[AMH(-{zhL;\3Oω02)ZJÏ4w ;g-8쮐>YR[+/SU`ä%}&kkw3<2IF S1, ͼs Ȼu>(곬h#K4kSMmi##aB-L_Y.*xЪ: QkVJ~F$ЂY+_G/̶v=,R@D *QY8f> ,@Ug܀(j˵-=Vu}SP zӒ͐E3OxK3)z.AVHv3\*%p/_ѬH'j9M%v2IHyJ_+R >UxO~."S?ƴcUL^_8' xq !۔JUZE'xh5v&˜1`gĚE C7>?hݠIPJA "u)wMWɀCDmd䔃cF'SYFgC3ebkp;<34Z.|av,WV6Ygѣcļ~[ JgB'{#\ef_;?fMK&e-3nif#rnϋ ٯt|g>?Ƃap ZThgF4&[eyKl)Jǐ|3M>Lg/w@uI% KۂwqjCi/Y A2=)^P.TlfJSbCp Yu[77_?Swxˮd77#9 $&"g.]B}j4S|pJK_,;}IkvI.(2-YP:bC&G0^8k.]u#?3R/~5M!j%o掘)L|K#|:g7KMT7]#בa&4W>ϪIxf^(F K,Mͧ!DYA}n G1v^V{,?>3߈Ck Lg%СA@_4-[)LJх`nse Rr̠lV^6wg=3N&7z9W}QDa3;B x+_6ox#;@/LpA8J;A ZHz'-3t[iJwSB@[V6X:Zȣm;!o"&fopi,Z:0Аmg>נw+FBvm$Q'] - 8ۮlՒ_tfNK{-s/O[$&b8CV ơ+&~hjwq^a!_=N䎊_[ń\3{['ϫ0J+\KSy)tjbrIe|Wb?ЌzIuT#|_IJ&G'_Wl-pT} &Ђr\'Fx}-з:d "VURn1GM4AoUsLv#*^qRx$7*P p_T$}m!T1!C~ø=pKH^EqdC^EKBi{6kS!&Cb*(1?vLr9O"|BCs'骳0X`{1)cˆ8:'|w4MEJs@O$Ð݊#Ѥt߈3K˶ \ty"NN,Db+_yPy5汥)9Ң׻ K}&jkPw&4ZZ*I&ӡ&C]qŽIXS>: w (*Pg-;dt;@7^q)DVu+4D:@,.%m͝qq%P ` ʥ5yqI2 -% l%^&Hعמ5.=VpR}x\{Eګ[BAHF7E/!o[ɡ=Nha;UnoHϔV?ڪS>H}Hk|L^,+W0_e32 }k{/U鬾L$_yNF_cnHݼIfc&eM(>8^O jsb|-sp1c/"jcqT5cѸ~ѷ:x:n,]65{DCф0s@fD0ۅ,ڰ0dQ} ԩ瞓*FvʵJb[n 3k=SA]=E,K|cSL oBkhN49䱛r@qXWa׮R{IpM„7 l,$٩u|O)(Ȏ  Z=N5]p]xs8%2EuMگHȞ/irg28M\n8+._ 4bfkg TO=a!1R!$(6Y^mE^40(U/k7!UrSph9+r0ݓi(!uLWpz7Jn~^ ~"N|*"3y/eBS@ΆBxJy}$B浂k~۾Vd C {fzitmM[a,T!!W(4.]"֢9ñú:6ݚ[*M|*fy>!fNJj95hfd-~wm9l%jъjNO(b*B^ AƙGD/[de"q1§UӇOn!o gS>xk+=(Ҩr3à"\/SUf`GZD:6wDj}+J:X/mVPRnQ\b;SFM)#&֞p1E l9~O\e@^6:iA?Y"S&*lH6nb[C^-M@m(ERhw3jJ _De%%?ͪ>D)><'S"K+*glwHOd"=u ZɊBac2uÞ476'ɨzx@Ӿ鋳{mgF'Dut{pP 0cl'oy_ODLiwX&Aa#ZBVL\e ‰OpJcszy}8|oңЊjC `D%DzAS6]M-k <]h\cAp>X8voU]LH=#82#Ȣ[g驪 򽡳ܯxwIڔ۲*7"i$4fD<= ~ 1Uk&VQnUe"LS4ר}K:WOpd"dz+ڷ5r)~Y.뜦q[ݵqPt/N=6MzQ0̓6-(C+L"7vax"{Lt.:8 JQoPyڌ͞W39ˉM e'FPk)KhI|Uhf۔$_iZ"|,߭OTY1nwc_fQ҅2+Q0eոР+Ig>I,9ky`)9V;F_YM+DfIcSmxg >FX*H霳1'D!#|Hr;οf1VU54:Đ-}w'MN{UR XIi__m_$}.v%n*vJ@=rdb %?tI: $:4?.Dh)46rL-t?/ 0֊Ճ#O'"OQ SPet2KyӋG^U5ӍQ,I5h (pwgsS֋{~L(Flgw~>)mn[f9>r( {`Aæb(ac~žf2!tTڮ6YP8 ƘȔyXp7]j-W?$d8#1_w9r`5y.aq~7Q$mwJlpȦM켎=j`7﷧?1;P4lm 9h"ٗqCNis)̈^ܡ  rCMlwH*x#tl *f:f;WCŸ]dg9>`XbϏёЎ}ːcoܫܿ*/!z/Vd-b a)Pp= n{Ogn4"1:gĞyjP2{2*}2MjIfW 8>pxwU)Đ (h;Jٖ$u,fmCx]x(n^rt%+Un'Ab(6>}- ՟2,- wq^C,kj4d/^w u,kJ5֩r'fQݒ_xc6GiGhvW'>:?+uZ\!;(YEF+7[:ݦM#$nVVS{6 T&XHk 5&".{ Gtl1{o#.P7 3*'adj_ėuir>Z[7K;[5$Qyb'9||cxw0?[_|Jٍv{0]>iLf&㚥g_er\#"6U" %•2ʪ榦S$xwe3F8̀cB8k'XQ-fc w(o4_M JR(YuZOXl;b$ l1.P90w+9MᾥxZ(YˡR pQXwyB5Fne~6b"Y5UcV1K=z_@:P/8xdl=v [PI(:O[_ 7P[1[[*6K犱:~I'n4c3 _:D(G+We/(oҟe^(TQlu]L0U"^Nj-UHłZ)|#Q=Gհ̊wGȨ1Jd&q¾!irmtnhRK;{т[DXPOV܄KŰSC0I-Wv==aycQ`)Z8Rg`?`K>|oLv;rQZ8vJϠZ&S⪹;+j,]Nh׶|a??2N]I갏J2n,Z7)ޱr7g m:[u'*:j]a'Ɠ;f70Y60r!Vee wt:MF|7CaR8H䩄' SEA ^f TlF`|:5y"sFe,SIν?$IQTD&JU\*Z^S"(qCslZD 8!*:ErcgiP.{ "v7 "$85i&wL1Sبw(Wڰ7,M;+X +Fs4$o{2X^DdlE)~w T] endstream endobj 103 0 obj << /Length1 1631 /Length2 9181 /Length3 0 /Length 10243 /Filter /FlateDecode >> stream xڍP-Cq@@ M7w!8!X4@pK;3{Uڲ}kzju-v +HueHhr^rpqk]! g0 *)g& t}SAnK+!n~!..aBi; PAA.R0G/g2y0Y2HH8@(@j rxZh, W`uuu:pmD`W[&n t:=@] ft %9h)(A? `7nM 98^`  d9\=]@@ t!@?*d%4jn7.@` ˧md0_ ݄#R+Ʉ  OK[^?ܿO8OM֠t;:77 l ـ?Aw{ I^V0(?ΗSZ_RWYώIJ<>/_y|~^AUOا]O?_ o.UؓhA4ne?R-H :!^!?Hi7տ_%_i/T_P r?1CyCާ$OO.OOMk-ݜn?@ O%u]]HU4^3ςs j2󇬠U MsE{ ᭉmwfm_'$(k;#~H&^+YWm4ln[c+%)X|YbWv 4cOi܉G*xVtؗ>kHdn\Uzb-1sv-.Հj -AKD1{5v8YAx>չ1 Tt&!]Üw~lnZEݝ62}Ο% p vWէŒ pwb/gv金Gjo#}$|3'q;[\"NuP#$ZF=I0[h9aO=OĕUf5AJæ9o  ۩UF  9s/u~g LV+Pr܅,Gԙ~nb[h >aӮ@3_ֶF!{uduC)'.\>wWBޥxk_v f'^&1C 0搱5p=s8RkDY2ZqIg]~t6ĭ?B27 zx`5pt ~y:՜W;6);`.-oExPU!.BN1}/EE  oAI73Q$]%y =d|Ryyjw8\(<:8{Vz g4Y iӁ*PǏlt_R.ӥf y;kUw©qzd;Lj&Ȯ_NFxPO$㩱 O KǜW2[@M&"%IܗIsvb\%TC^l'*͔j^J _glFթ9+ʇ ,y{Qw`mw3'yZNe扸|(2Wn~뗎*҇hX2TFA{Rdjڌ&͇S\)#sf_g$:. ڒK=J {V7]ΌM bzU[/Ƶ8 [cSo>_JvhYTxS y@\rw}T+qiLe7=Z?nD؀>SH2Y?8FSPCqG5&ܢ|cw0k],zY\J#a!r_FNgRP~aЅШf)\3)e-#Q\Agec@nahҏgQc$m(X6V?],HGWF-wO{:t8SX&yߡ"FqxFoX7lzi+ EG!w'즄BR1I-JE9 XsMb#-#qIsY"ne"_E 7"@9 ) ӷ k$hc$ؑmҊ+ r3Dj mAC}"kw_%v{:,EP\Ĕd؏r\nKg*%^ |iqYna͞Fv.͒û1٘%~ NNۼsCƟnH[}aJ*YV݂-n.w k&V=՘xU_E ?^}фΘ~_ɮֽ%-6n_ȹg@IކཝX)b׫*dTթ =u%"\¬`Th#i`Z;h2H Lhx܃p<[Le7'ʊ7RvJo[ޭ99Ϊ[@ e(ĺ|# 7H'61#Q۝Òt煩f-):9:<2r[T7iDҖ9eM*|fANEITז0Ovmy4~&pB<xr2DBy]~ih4Џ)J|^eYuc#I0i*:?+j;:UReVM7'rKһйAeUZ;=DDSkc:@lhBZh?s:úPIoIuu9|iATjN UKW&3 YůxTD||edo[(?Ҭ >;S9"n5@j$C9裎>V{ u~jTtwt<]"6YEI'^8DϚX0#Č:m>IM 3 2[?m\֥IJHe;U QuztE TaF#旆$$h^&tDC5%5gvDY5/(}~7J\K%G I@"il%8RoPǦHݿ鄫 :X"J~F&-%EiY.AG *X_ՋwrDϠy+ҧSXӭAfVi0^+YT)# qg\4*b'CE lNkŌTdI/E)wEgjԘ*COk [Ѯ8n9˰ThCD.4┊S΄7~Bra{X΁bxJqhk*晊~hh Ka@o [%'2bvs'Yt>xU}vy)hWy[ C=IJnț.%UgE&tXɓ{>DKc߆p5*cDM .ݫ 1ZQ!6ͺ?~=m7a#: ~݊nm?Ni7lB'&ظT>cOP'4"wPET8,z6t߂pCK6 ~C$ Y]Ȭ$O9?[\Xal˝BV~ff!d۔(Ϛd>1u/VJ“,P$D{gS5_g jSm=.YQ `pRTNMΪJ`H|X}\rC(U)uP5?ǦJBJ{s"6;uf6N&q!|ZԎfb9ݖlEWGQJVh{|C{\9dzؒFE37 nBmu#?/TE=|bπ +&+~y%z6?{n(9d@:$F5`}Z>ʣEL2B%xэE*#Vi @-% f*\WWٞ)lptxƣ9 ϙqZv l8^Q+02.NS&}Jϳ>; {PLAԡ#l;):YϏo9N -4U?ym엳WfKvxnsoX@ɏ>q026Kf>g$o^}H%6op.uL-r]Nˤ+ΈGP1P=.*3xa etdTq,h1~-ZgZB1o{Ev}Lun T=Bwc-Iy 8%/_Ed6_;ӷ.Jd0UAZ$߽EEW 8%Za $ZA={X0!.4,'ivJCS)/WϨ6Μnlg hŀP`WМ I(cɞNK$Iʆ\C\ĴkPI¡x3#hc9rlz's"yJVk-;wסbfL|B4-Z&V"䓾-юW`G},㾰A{Dh{իQojLP|z+q4Xƚe_hM2t&Ƌ#W' .se ;0sDTs||:r 62mk[a"!Bg?#!2n #If3 ?G Xa44URQj5 (AQ [:zpň~#NOI[`8Y-x>p ˒R1WWTOx4Jӻ{D-E|'_Iz5iYⴓhHa&M  .ͣO!^+m 6ʥWXSٱ)0aMkjyʼnOcR:x=$_̸+LR-R {@? ;Ok# )=O8Su6ũF1cǫTm `-ke25R E]-GoM<î|Zy*GܣTW҅a3dSggkZ9Jx¨ _)zTzE5qKnh cx#vG3 C;*p3L}ZؙG]).GQ-Й AH.ī1Q]^82,df|@,zSSڌ&ꃖ 5K}ҲH̎5ZA^âEdrQuX!!{|r؇KBoo\y] bU*9 tŠ}6r>,bZrC,bյ=oq>j| yO3dl".Z8 &bDl_fp*εYAyjQηϝi"?ƞ7 S5C(ֳK-WW޿U EҸxN$8ހhek6BQ!{5g.J} eM"g5b-HgR1vaϞMxۦ?FF͓=:pp>˦ -cM ]QOA/}s!3f0emh!|kW.e=2+tbQ3E̛9|}ʇsQ:Qr&,.J#[FߟdS`~GaD4NJovS )OJM7\&<ɾAOD*Wŭ S0ĄBˆ FGuVrE Vupi}T9Uǚc}qk~[uձ'юnEF_s)"(_o}AQ,l`<D޸B~zWͶN:M8$9fei,:E܅ ۍeQYAZDn kuG|Pbk{(5 Q>+ uon4"V7reioLg?y}TT/~Ȩ>&~N+Qk5f f'"/6sԍ%q^s㭭ۊ%ix=1(3},[PF҈ѮOa[Igcjf>V`CϤqét|a>ga?63aY ꔦC/.CMĆzoܮ_)9Gvm5^³mHQz#ՈZ~ czqAym)K >DobEQdp6bq\Fap b \ƍ͟l>d4ĸCTvgN{{(&K}.KU-GWh&m4]dFfe[ygϾp1zu|HE/j|PV8 M,=!¹4fcsC$Z7#κEGW^3|IԢ [idvGmrN`r?.H# p^'ߥx" 2&xm>|@@qK0SV}(Gn1vc*xW}NcJ޲GJy*{E@`d[xomMmg2slO{a9 R_ 4 0N;bsN*}r+X4| F#7 wnFFHƸ z=K$@Ii8] نy*I!-d>A9w?QQSܽu⧝{/<\WZMnyƿ)3dgT (>#zљM竾)o7pwvFTXb6e x */y!r_%H0P\ֹ'8JbD 0X_mW؋2-xYR!8%bJ3 Xb$|-p :qp^ɓJW@|zwf\ K0Y5݂m1u߷gCb2m՜cRͯ*ſwL2% *bՈ=: `޻"o1O@SL틽K C:Wv /6s{;Z3i 7i)d_4`AH^lc"}>s}GҚR{ۼf(0a-=aT@/NV;J–׀}hOns1!f[;ǪʁA8=(wM n/JD9IwS?F}VQ c7/vqZӌ AuZ+gvv"s Γcӣ).bHԺsB0;ʕ62tD}^E_4\Ya7qk,SN5n3?| e0t4"]. 7nѥ !غA&֬ rvP0Uό~Qد0R5"G&BXO4{iTs,YGct0XCΘg8|Rd[N_,_uf)K1,xe ſLZW ox9W/X0Da3-{i:KWwaB%j^Tcd[\6L6UP$8Zؐugzc\#*!AJ&=~]W#TY; G$+]9-g^\H$ZP VX4z}/H8C]-]K2mnBo|Z)Ru,MTŵ˝ QXXgk؋ETi)ɞ(o=M&TP5zSY8'Db+p80. 6bڼqe2;zbxEO{.U2F^/4B=7mR(GhI78ETO endstream endobj 105 0 obj << /Length1 2480 /Length2 16278 /Length3 0 /Length 17725 /Filter /FlateDecode >> stream xڌveTٶ% ݃,;]w%듪*u_̵^(HDMv. ,̼15yuuf33#33+ Bleo/$7vQ66 '/ /33Nqc7+3#@@!fdea?Mi,<<\L .@[GScLP[8213:3;Yܭ\,@g ;m-(V]܍h :jgtdJ@)s9ې_MMm<,V6@< =7tD+xc 2t6urpqft%o3BKؙ\~'n4Uޓwͭbag  $B#8A:L{:RvwRZA݀'WXXfV. 1o '+3hY̿4gfv65IATITCQ{X llN.'' )['3/P?{Bo[̻>3)u5쿭I/P/8vu=h)7U +ͬ\mV"vfad[l,i4Sr1kLk^;+;t]3NA Z*agjo{X98NNƞ̠bx <]@G }N[`-qD n`q1$  `L2ȃ?OSqlA j;Ie@PBXEjg an/v Xq[~ұ$ Uу@ [vT?5Ș)>G]2h0tTE 8`rPm]]f&6․* <,pF@ՏDwZert\uT%?sljҀ/*zA+ȫ:zv_7.="k_@aiޔ/غ>VߝaoS͕!|Oc>{-wJ`$xh:*U|W:\SIOH8u`Xlw#.bNtQdR.&:e\]ݬ,;儻{"F!TF\%&Xoeb . [ÛYJ*;9'M}}jv܈lb?Vh yآVőtH[)ݛMž$gF\x!MO겚hg@zDh'H%9#9c/g>tԙcr[ ~z,m;TK_yMf t/z+=CfXʴNgܦ Ep_ $L/~/ u9'K&AAŴ: oWg99;Gm{+F4MD2[4]3[{8BJ6b/[fGXrw8a$J8[/<ϟªCFibāݟ}yCR[顟3`%ܧqeDoz }3͉FTVaTk\3nzDHdžξL~򜨻/O(X$mPK4M2c@ i-aF\ 5F6C]](̯\$Dc4š {^]8;H-5?_UÔxCrW>1I RR1S`EN+Rrʏ/wnG*GDb۠azã 黢=NGs@W7:4tO)VN/FR:-NzBPᩩP.KQVC衬oE?ـ{" J1hWpltPW2U\ bZ~YI۵bg[APky/\qx3YS>yeĜwՙcyiBe? -@8ShØ%}:S /Ƴo f< ˚qw&:s[٨.9L]a.ᒲJH&yQFPك$WLɆ @ػf+dS)y%0w,dPD]]Wڃ<ҕVfxfd3|Yfѹ?aśǀȇkT0Q]S#vM]gi@'3fv6 m||raӷP :blJs^|>J7/XՒNU8pB>Wy 93k@Xm8X_fUymjLU3z!c}W^L"G.# l\o6it-]P/:Y{VLƞ/>*N ˏ(bH$gJ<+}`]͘>5ܟC-p5)2~FNȆ\Cmڲk'\>j'DzU9+APlb+pD[`j(楠do(.hUXM(=lMeXf5C Oϱ:Sl!z`ޙ_~mRdPULjD\\禕!-hۯF(]6Y<6QEy<H\MVE"`6ȖTF0/7 8]k7yxe/*MNte^ &oH Tvh/Jl(U^~ Y=L|1O3\E.ǼL,Pt,.UQAZDDvbPg܇Ҙ3 }PdH  )ab9j7̔ #[#5:ֻsas4Qf#Q +&sbDӗ.7dֳ,$[VZKq.mU&?ڵS{Cܕ]5zU,a7Y ћ M\#B>)f}jؖOfas/Qw(<X}!N{i۱=4{|t9x^l17gHw<"ĜM3"%JOTtB[.yHcEY~0w2(NmLYÏbG"A^v*ۭP0)Se ;ɩm͡g']ʏ_Cc e±P{Ge좊 bZP>+[D:A)UٜaE({D$g _,eZaz,oP QW#ǺqW#N .n4E/J6o{^߇P2ܕE"" ȭcI$X+GGd@q6m$ghzB;ɱo\eaZ'I[%ClhLfk Fc!HVk2 |K& K:H١+ubXB,F /OdmNou@@zc)C'8 5hR 7&qqyLJ*H޴u޷VDKӘUq*{s?v c(C6=zІ7EH5 j'>ưe~Kڹ`hk@zywNTAeONEkZ] · C ~@tEEe. ՘?ս}Q?!UE+&htXx.$s~mU[ׁ 괖`YN]" ?}ălX^L1p6B>BJO|\>{(Ŭ| uXsbӞif5FPlO;i/P: g{_ FDy թLfu[wlbl{:p1|5WkCv'x1V_.'֮[$^Sط?Z-Oִ`pemtVsFlKdc@tU$lZM`r'O/\B>F3T0賚m]moҰ#&,1<6saz,^'\?naXVGpd=7cN ?}H摟 "͎aoy+; aUdz4fTp]_މEނ//!SoK#૱HŎnƦ ^sXYpǦN Xlu'[V:LnQ~mAI&(4]؋VN\ 魡!q^S"^ړS ù+tsi[dn[.!e\̃еkFFbQ]S#J`W je|-LN)BbGOFP{dkWCmo58?g6攤24Ƞ'xZ]tr#[up_R Z:BfE#ѕw{]>O);8sNRD=6ԅD,!X6x.Umm`Z-y?Au,-AT {a,gB;N Mx<\"Q{2JI l _c@AKB/,ϙ"䊊%:o}^TW~,77r1)B luIfJeFtI&fx%nZNB0ԚIӖ6pdOEM"r2nrѭ˶4ه|\b0S9m)"#P3V }A hs)K6'HHd lJyHk^'*򲥈''A+4oIGLQ%s$q./0pa=*s66}u[Gb[,"IkI1]8QH $%P<55i}9nFڸJQg.x l2hϖ/KuVu:WN*i2h+\ P̑e:[hW%lt>rž J3q:)D(GpᷣBq#=6==_;/8ZMXŦ8}ړUer5杪oU17%e/ Y7v*} aaXs}?❆z8{,ڣ^A\ԈT40~(}8.'WR#;gn{혀iS{X~}ԟ PLg[5LUVݟz_Tc7Vǖ du2߸ co*Z#-_n UNMke#@8~Kߕ35z >VXUV(Q6EȗX[C¦ݯ\-kp5n%H۷my#G\eE@ j8].F\M~4/d(afXDBm"F52u7˚Dg a%-BTD^(S% X ]-#[R\}o$R-ћ`Ԡ($/UI}AE/ @CddH:Ƒʶ4vY rԊ|̡q`!\ 'N3/Gqar==cě -414/U_ Xd VW֌_z.2%i:O>$W PXjwk : bx'? ^bpp# x?_CVEN8ckPId0󆈫P[Ap6KLrjRqE|wXc^r@qؖ:9kB׹ψ֚xe^i>X?W Bɓ.,RUa)& :Si-PiWSrJ/WߪA2r)&2̬7=Suv~\ð}Ӂ@[]N3M j^P_H&.6ՑICjϙ \Z4øF.AnOjЍn0_$4/цgJsq̈́kUŔgS;p "ז)|xF9DD\Tao>0B7zw3w+ٷk\2h&vfQX-Oϑs)Ypw&ĉC|z2L yjf ڧ 5xsMCYro$ y~ɾD &v)HG<+੢ JgSk^\IQq7fh)6;s'A#qV1 JY+wUVb>f[T#dN>Ʀ{t5uZ/YZΝc玹#*}xTi'p0>@ZbH0|1%h̥Ėoѩ90 #;%S f]Au*uZ/N/%۲1r/Ղ:Q LG3ThCAEk^=$ߒ;KK{i Rm>=LH2 p"rqj?6aKX~]Zyf@[H1TDW;ˀ=ީCي%H]Utwx )êYA`՗(H7)ߚNvP2 =J<F[6 G^wd*`ni,NK^0 E5'@u795>ͤ_:bVOwjo8 ot;x'~ݧ_y KkUDKq,;Nq3+ʱX`t2r"?9VhT 7;ϳ̂t6#QFN/uV/Oj 長p6 ]HaJ? h9Ь"3[WЀi|IRMPL"ȗ3\/2(ל'ucq|Sw0B[M&CnZhӽ݃)Ն oA>iw`h]:? V'*:E7RW'N]֦gq'|-{ 9~+':8 +D$F~K$c0`jySr&D4ctњo[/K77ˢ A*p<Ҭu{0뷍1%fw,(,@E#5'!T>7.?ӛ:T?µB|4YpZv:^`:} {klQ6x|~BB7-, \,rATwMr7ZTG7jM>X0N0ႴOCOxnUEQAG=m<(cTG _\f[ߡǕv:i/頪X"}N?Y$cH^ .dLNL<@pvhIG!tQ6BJ+Dk8R=^C}V6c2AtMI[~z${ak綗 jkρV Lɣͫ٥'O걮D4Fwx:@7plW$>EekMϣxWO}!3NY+u[U bLӕ+<:EŨ,f1ŷ05JA/db^K#V.dvŖ ӭ&/? a>^-1Hdfτ|Z#ըᗜ`>Ȑfm Έ({I|YN Ex V!3bY xvX8[Z,Iһ/F,\'s+uA||֩4Mc/5?V '1%K[ď9^vEDȣgA(%'H_Q].p\-|x yɵa0ˎҳ!(Kޕv=%d~n,{TaK۪! =acxa  "z%̰{!5$>n8FAENE_Xհ+9[)MIŊKd+urT'M:Ne$S'Hx!/{P e;"ь,rp ܹ468_b:EqQh d0aW<:G=C?<#?TwU9])Aa`Hl;S6q@+!E)gs NNv{JmB顸u8"i12 7ZvkIfW4D!7G6=jz?IRKS^՘`^R)[v,I/ .2{8iE.4n2uia ,ԩ߆MT8-Rz;ZN5L-c$.WWUt%NwaԴsnY#:1QFdjG_&,*_]dt6.9\œ#KvqQP@L{OR1Iwzi !$ݑkOg#?{>d14 VϩByA\;-鱺n4;'$C:wfX->E3WV,9s[c[2z 9˜UMS/£EeCNgo` $e!Q>7W2NOh#a'22{숊xhgAa'3#)̚^%T)9% evPKؕ%n2HL/ku0:KO ;O<|p=_`{Mk-c2B/9J,R]I8%9΍ev6Ԫ@0){}`P6ɋeoOS53o޳iu֋`2iq/?)AKfmpq{Pi],]d@gRDh8䀿M^_@k͐?aŁ7b~bK!vxPpS6OmSBK{Q8)#KkziȨV*][9%pM=NϷ@ۏi_pmd$khןDoު]:Dڞ?;RVE6-3G YP?uE\srPO~eŧ3~,NAc؞uf. 4?;|+`>BBAm$OD͂aD9j/9[O Io)Sp?M0Up}?Ӵ+h6ZXv5hʄ5ʑM<>_d#GRţG=[o% ]Z+Pxgՠ_zfܩ9O|2v 1qʦKVRJ宎1ix)3vOUڼq@ikRb%E||odf"g%O()IxX<3;| ɳzՠڸqz$87ڑ^\ʹ~~eR(nkۈ\F3z[¦/?0X-@uf|pҾQI8ڇO+k`KΏuLT?Aԁ d3ʆ} }?ARD&z{Shj$aBE7Fm({ {^f*q yPAH[h0O_(Q]_y[gt])S5$Hu(q/3[D($Ų{ H 묚@'i6k;R'A|o8$%ʨj>>9ئr2uCz!8\N|\)}XrO5fqE7}{& /lc-voӇ,Za`!T#'fy`mXuCA5~W ikiƢعt3y{]s*a:_:6.p75lO.OR|7+aP/r ȍc횽?,i^\@5ȩeͺ(D?LsE3Ϙ_ <&sO;q1,FcKu.su,X0̐-0kxIvJkqf!$(Wg ,>?cS|hT`!ᆥrR\Ae aw{[‘>ɕZlm6eI&IG )v<fD<{#VTW:3 "15w"9hAbw(aq]47:e1yƗ!n_S:7fPMYvavBӤ1xci0!_v/.Ϸ`x?ԈszƙRE 0=9`=;HGO;5EZTA~ĽC,>XYd)KGYʷjA7*j=|_3shR!o*J=["Sd}Ή><#z:IVƽZʷqz !(bk`90Qw3 <+:\`` S|3X?~ LnX8NBfvHn2Іyx9䚛4H_}Ɣ+;ϛ|Рf>H_˾p{ysoR&nNЭ+Yq ֮F4M[Yp2(>^S /杳EU[$ DZ; ,CfbhJm^,*X7g/s,qĚ SX_ig1y)<.!^3Dn?du,~1J bM XI @EIX(IB cZr>ڊA.$O/_#M:2b6NDHDJӖ`|mW"-߂#E F&^% @gw\zPY3od`.TPqdSGC-6G;Lw<"JE|ҕz6Jj)ViSC-;Fx76헍81ƺDVwHOt֗"qޭr+mOV[0G?4Xl$_ctTJ1V,FPXx3L{FErc.t/r=+C 'cݦ@UVC Cnl3厘NV!'<q6~^)bΖLEmbL7h\;\)ȗ(hHPYVIma4# VsІ$B}CKz*llݸba(¦'bd]"A5>q8'FBH` ESf`u2hwW\\Jx[>/#[*܄>]jFXY'0 jsE+OP7J'Y9TmV SuMx[m^7uqc F l`'캯+Y53CJLw0~1 (Vjci"]J/MW/No*v?cU&I|3 V%?Hnֻ~6NKB%q~ "X74¦c ֪HY܇bـCIاGY Z<>?G&hd;ą˭6`tFɊh{#11x@_z4K%x5=qNyVVw^}E)ʶ|Y?8'e`8~N ͛Ia+XQ)+wx˺3us&zi=~RE{u#F&GFUO_* q B|wi H;AzH/W[sԹ^Mttx2 L.]^h<,#<{_͎E5ms[Cyй%,eQ"jf[0th1869La7K|x׃NXWᏯ??Id.&ԁO½]n=kJo?ƛ +Iꬁ[MBEFY<*o$@Zh2!Z:O t *tޙH(W+*9$bUk1w F[_Wʄ' 3d]irY/^6wKL!@{y.VOauQo L:fX)uL 5 tR=yVLE1+(HH__*wPlށݼ u@nRN6`^"*[Jv렄dLr`T<ϱH }IU (:#$p40gmzNk+]dHa"aol8>FPp?yakhW؋L8%>S]Zm0{f8j!gpg?|=mB]yLNXPeS) H~|o??Y_ W'XLퟋhP"73j.ۿ557 CZh}fa Ƹ&qbIO#vŽdcxL(MR;ZrZlȥ3yL{?xC*uʻcb9# W+qk{#P!tH鞿y_d"R=fD:C\R?; _R/ p,l7fG 0Hʩ, $kⅇ'ͨ13x~䚘O6 .A)WV ѰM=Dy+*I_o!Օl p8{Q 1j6YqnQ&Qcuh#;9aY$dJTmȈW7A | y˦ssAtRFGCueOeG \9ἒ5<QDCЯTrtuEp ͓Kht֡ng=@qs(_~iI {iLfl]BgW\Us46t/w+*{h#T!s_uf3td(YZjK=b𼚱ԆΓCԟi:Pw'aqfO!".hhMY,J"vqLh&POQO+Sf~bD`I _l☥C;Kr}ҝњM1/+|sXk SaygNq1d,kkl- bMX؏8LbD7|G\jp%̋6W8,ŖlkČWRPd{]^TkAaCh,O"ugB'Hm\VF2\()=1aeJz;69:=U˙Qf김%%PBc^Y}j (˃N~ "d,*G/^sҞqlȧ$Cs> stream xڍP[-{pƝF[pwKphqi=X<;] ?̝[{m}h)U5XLAV6v;V ˎB rv; ! 2$M D%{- VW/@ lPb;؃\Ph%=V:018yY ہf&%-@ xW !+Qtwwg3saspad!Vu dcdPhV`wg` 6ٻڛrG_dſ,tGlg'`T D[x7+Mj qas1#4,eo.`gџ$dz/_lon殎@-{+HNoΫ ?6K9@fV? hz:tra~`:lzb@]At7B S%?_ ;=_`_ 3w+k+()1=9xYx<NnQ5?b-zNjo 0 Υ\?Bga7{!*#Uۑ~oƫr]![ KJ sz & nohVn6v`i\ 1K5ٵ7[=H ?%3y}E\^ C]Wey 0qv6DyWxJsǟb !}(\[P_-߈z)JF|菩YA\? 7hoڬƫ vu"W%:;ׂ?d3Wgmy??dsL0ĺ&Jĝugy%ζۮZW^Ԃx̯uCF]|v5(um[,>.:;sٛ[4_M38̦5U|:Ao͆3HDž.^Z|zC\l(Lz.gs`BrpQ2@^[bI4v˶@SԂrۓ1rMɰ_Nבųz=V%f$iUD-q14c +OX;dM4R^&\KEsVJS-Vje꼬mk>t踱/v_^M&$Νj1%bD 6S顲-b72h%sf(HJS&r)ʵL{jKGL}2Dhgu݈t]bUW [>k PCTJڕ@H.L { HE0DUVQ $M!nu첈6b_V+mlMIX`FyP E/)[}e?1^ lM0xv[]޼ uң򋊙g݇-Ȧ2<R%~A^B'Z$&K, $j`:Ss6^AA"c}b08q/^;\~6@B'> X:$l^ؒ~f]hvȠ--bc3A:z1T8;E]gǽar#D0,yK/ǫ+aLؐa3Drޥ *E2RMC@z{;dV[]wuOuiTY]je5ڞ8m$K' yԉT(2aY̧G@J2Eᐋ 97V OTi`qԊ<^zgЫ@8' SHĨr>4SwZKА> c{6&v h\r#[2 WYad%8˴S&6{g{2L-J+&҈}4C-RmT;ӱZk2ē[Z8C%!UWz{~{[(WKf{?9Tfm@I- }D"=BvENMD%hNp[lc($Z춰H]DOeǏh?.XFi8TGPEYos(hiGLW~ZdE;KwBRcx3撤8"^3Q @?:60s|[?tflN.YӀi MϾ _| hٵ60'lt5_S„ **Rdaށ]3*d)HꝲzsH+- Vۧߦ|})ޑ,xGpT(ic} -XA ZXrK^Y?-6j\v:KR2t#DB1&eo:afQEt Ig6 nZ\N9=_@6L9Od#8|ZˌT9}VL~ }nSqpWhttSXx /"-m&6"lxmiVC4j%And~$H婉c&Ӵd!勤q8\7m\.돎u` ^`vQ*b;#cvQ tprLj ?F84=Dn'&`s1сpBo:,>>tPXֽ uuo̧+侟}\OdQC=1n}ez521j06Lu`wiQX#&΀jҰn^5>İ|W@5Vts"iqK&W6%xЉ!ׯX+ō?e$ަLՒt xJX+0qq@ <;"MFdzxZL͎"H쨚)?dlƯ73}[`1Q p$ĭh0xr#ų C)e98mcޓ ,ZfIlN~n}q{{M&:ݗO3+9KX4CPoJfJڦ'@7H+6qf^W&wƳ4I}X(Qز?e Ӂ$qWR&~XDBGaؘ:JF &e90p}D.gz̨~xoazM%!1vU> fѲo;P NN7"kd143?#5H 2F PRA|g,+`ps3;? ԭTlh*exAaN v{E9fJS6"qrE.FFzP|eSZ $x#l4 9/R?957 ;!vb(;pSZNEN؎"{u\ЮӲׅB;9 O.e}O+f>m)c aQuʴ^(Cg" w%ظ[!fXݢRAUnSzmb"b*0wu=gk5oM4w)sĻ*YoH>nl]bNNh2W?2>Y*wȕ=Q0_h9zZϝ/[;"@ryN,FUJiޯ*{ }YvF ?} >XN RA~ߗ-#a;U8x;`jWՀpT(fC=?R="VAkI} H ǩ^7.:s"ji`!kd()\b$}4!tQN#<2ȼ<%.W$L}&;b6Vo%t'og(jpݖ7ZrM0GҕN7_ʈgX@u+Wک8TxD&-xz6هjl#*BXНć{a$#ߕ"wmyB0& ˛ >%|..]K%ƎP22`Y]@ g]Pj+ez2a2`ai--lnaïHRX7ډ+o Pܸj}z?7rV)_Hڥ E#;fE/B^7I~LR/na*L+3/$&a22woOj I=ELEjTBV/7UOokwcg%a#m9E 5SY vCjIw97ERs7-,33K&jK0W7eHĊJ]?Z+_4a)Eh[Pd+gkbI_;B+e|aOæ.2&) L!AQLF,TR@yi ҘUʌ``/כ\ .8p뒤ըt<+a@ ئ= Knn[`w:,󤏜iw8T ,i>|,mf 4'[&T2׉>.}A(P @i<`T\YqB1@ Q1@.OE||pnJ֪ZH]"/%1HP.AKv_!~OC* iM{4wsqԳud߹ PY4`}S|9Ѡ*]>7+FDMˈ(}!X.pp"a'BP%ZKc>?#ݷXMHh8%.;} aַ,'q:w: iH$3QOmB{%+$;G̙l#VmW2 ĈB+(9;C$0-٢ԝ@4ˮMLd6~YS)3CbvzڴUJ)"_roB8 8 61Xa*Dǿp 6 oiƾ[N9ɱJ)T7]x(FK>ߗ <3xƆuӌ(<~Zi75N}}f!x4AWVWIϱDnGRuX0Y`oyq x.H5 {Of}zThhgńVZ4 jPNR͚Ӛ(;׹V O"+mmQ&j :pɢث.A] 7A/ ënz֣z< "^C bPv%E^o tD֖alٸNdh?j'8dbD"k\}ClHSD")PrӰ*GzVj1R㊿'?f &~泆uT]i/VQXVj}V n0VV1Wǁ4'o*YcE\ 0rL|Rʉ:[>1{FzSz '{\";?)cJe{B7d&<-&ڑ-~gEḇ2 084'`'z0Ih00m'Rz I&f([ۧ)}l+Npu*Ʀ֚bD]}z‡itm3E;+13z$S1Iʺ1UPB;V*+f+jQ3#iG:^7(d ʣd|'¬u3"[ԏD=tM8 , ͌~Ew&P%JLHjdKT@ ﳭdHC,2 k7mɔ~\b*J;(/':,j3l4 LYBπy{#z#Ii :6?i1gjҗڜ2\O6'uHCU7KΗ trZbr{ Ug9VݣQ19ɿe]ɠ/s:}}@KRKxMEŧn;ır#wқEH ?}+.#sT|_AkqD nN̒,}s=@1-:Zk+ kz]w!4lG:rɻN~q[^8GB ԟk> s8~?k|kcR}X*Utt{M\[~U2:ܴ0;*ﻛ9 .JŹb*jrk3w_#KSH\FkZcDw680nJ 7꒼i0Nl0V 8CS8?eYQcxuᴖj[ 爘Iy.(XNˈD[ ffdWq.֪^olC}%%םSƀsdGOMyԢ}A; 7?stlH쑗G.<8 =N]Y!$.roDϚsch'-e"EgM! Ltg!k&PY#A§00`H81G*T-u0:9!otNwל(y Ǐh$e~3yڂ[3k"3 ?uw>4- ]Ȣ9VDJ4 DT~*@(i~^2 l\'*xe{vTH;Ӟ]SEIA3IH9IÄBVv{_"xrdzЊs|~ވ\#jrjE Ǒ̷_noEy;'YDjIO| wJ Jf-GڌvȄ&9R=9eEq>*(=*^:wB΀{vpr6l* BgL3sa`)3>p{r*Q7Ɯ5`Iy7 n&HlQR;W\%LYT!Kl*txpv)iֺ 3H ZgZ{lk eÒmz PĮ!qPk:&ouTzW1CW|Ytg~2[VJ,` -Bu6i\,cbD,u+7N )0XǃaCQsJT#i0QL_+s)b1d!@^5Q1U-_#~cJ w^i@kxԕf]Q/B%g06`DtS?ڄ" 0nϔhp78E {iKz)@Od0IN:Eձ O30YXo۳)/CAi84`Zjh<όbJUT$şD:ӎ&;Y'(^ &Q@Wj|:S#r8n_d?GyJ=DQZ\F']I v){Sd̯- k$4^M7tZj2 g.Qdxbi26n;.&,k:Y"]/V4 k4քj&~ܗ?I%1̺[㫟];_{lU^bo1mZ>NJȶ(JOkA*z͍4X1qp {0^XnCYkuO0 y`?z2 wH[/a3/fXc$Bt3j+n ?Wg5a+b`Q__*Lj ,D\o[ 46o7</u8^)5-B+mÿʉW,| Op ,T|,>Eͳ}eE5"K\)嘖 I繖 bex fF;.2bB<:C_wBjqs„U~\͒sHiv,^~4N jgA4i0̉;Zé3f1DgGmշ/jxM© {ms|jg= "w~$ܥ꺂%2q"DgSh*僸@c[tA6:~4 q{ci/Wm9Q鴁te򹌨]ذnaP#cB=ߏoR݊"*_zkbP{d=Zwirz$w<-`⊾Sr9T{i>EI0>LTzY>-P%y2⎮{a%,ӎ~0)H\ntH3n?(SZa^9;UDB\ҩIfGя)hJ#L~U- U}.+nxWҒu|M)Qieh`53Mr{…vIl. G Nq0q&.kT>=m-H ƀ4n()rwe ֓޽SWK;S9Wru*!Etc)$OM+7 CcMjg@yglS5Ej/0L낰8)|N<(Ed,ׯ-mUC[pr}R+~p*LfHE/t ^;ϞB Ƕmt~.%כ`rHIKfW!zүk6`>^UtPRpKR`eדs̓.>Ds#t'J Z kJ{hk;"X&(eSm*KIXT?O>2mR>q w9Zm=g&\NK&ȢY ,=SA(/:RTy1C~~fS~>4E93Z=Lf/\C]þrτkF`͋KVr2vt+Jܘpslq!Pq00UcO 9 endstream endobj 109 0 obj << /Length1 2335 /Length2 16691 /Length3 0 /Length 18079 /Filter /FlateDecode >> stream xڌtk ǶdbVcčƍm1۶fc4|s΃}kfھ!'VT63:330DTULL LL,p䪖6ՁNv<u9>9]l̬ffN&&  y\-Mr i;[G|PP9v:Z䌜-_>2TL,͍ٞ5 t:MQ}9@_ ;3g7#G C`ciupq5:>Td @ˀ9PepvwٚehddojdicdawFqa%s2qwvbp#_a>,fk*j >[:M>õs255= Pm>Dpd@g;+ X0@//{;{ pvtxS`ji 0[! ;@cLMcLlm<}Č"jhMJ;w= oE#WO)[3; vP{=Kcn?cdyv7E[z荾Xxcn]?v@cl_+4tRF lknFZ:[M-M,3K[_7 >pɿUߌb&v- ;cX^h t{ v.v>3;G(_(q?AF"N& `X+Q q|G>"GL? }0R>2hA4?tFЇ#EcG#kǣqm0Gf~&#rwpؑ?.]1Q?bsglX|,?Zfѳ?p|PkX?zfe10S·?Q43=?M`b 45GϘ??U#C-hIg78|t3~:9G+]?Ȼc?: tWL\?_Wc hhgdUX-F??GJMD]x/4ҋ+Fu'JuRҚb<<58Up*\7 ^U[K< I1ѭ_½n}*Y(H]y<(gO04hwsh9SDqp>gQ^[,ѿ<+TYqpq>ߡPx%Kc/yEn/e3Q3lyuJa38pK1k!fڟ"-КK+4 >:Қʹ@{xl@iɜNx`5~ q"=.(%곚:s?pW,]^I>wWΦ [f C3*P,|BI()^{=dd {kPyLr,*^As4:X>9ŀw䘊Bqjүs=U!5CuA2([xI ڂ}~tmv-Z1NF宎I5D<Ō5Ѹi^:1.pฏ^koۛC08W{jXYbcZfKͽƚvaS~OY)] i#2_r ar =+("3FFJZ~Ӭ8Ҽ[r)'j>f3VDh;/\Rid*6vsїҮ<=;2=>S6-8sf`a8@1!8#$ :[mb4 w9GyӔ\Lv_ZƂ_V=䧖B)X;èԸ3c xjk5-̉bSMB3~̸}k鳒{3#hYrsYwt9=y0S51l]GhQ=Zut,@-`ź1#D<Hdx4D!-敮D$\=w=Y^)RQz,Ԏ!3(>_ԱLMv>W,EƝC.ʁ?]yL5#g18˾YEx~6W}is}{| Q!*\+^unIEރrFh(~+76)P|-O1xțȀD.cj޷,-K? :,C r1 R }CBz9J/iOe(ev)rP3Ŷx䎼UX%X8ts/4(~c18XA>h\?P(6I㮁365v#IAowUM n0£@k9֖`~TP IkeՋ#Un+kG혈~5D[_O_ZPڇn"QCk1ܗuT0)Ov˕tQSw #ĶYy:m92Hcc d]} 4U}5Cjms;stN ѻDS PIOhw{>`$fVwůEc"sz(nW*A4{^UQIoj`\~S y_xe"x=ik&A-`p֋뛦L.J+SrЫҜgFxhR5RWTʡ+ D@R4);ņNJXdNp@ \ ZPsQc2''c26\:4 Dk2zv0oqa6JvUF&7M"IoF&x:FZAޒ^ZI3wEr&_~JLeo_J"nCnViNBa2 lan$`9ma <$tuM ꔧgVO0Ag Aw.BƁ&놎?( NbpcV[ PaUNTL!oAp~RV,@cJBՃTFӛj~aen-` @׳sQI9 B^`Uv+[!N?a瘱a[C]Fd Iwa_7GsH#Ywc%@q.7MSٓS>V(Ic[zs l %Ӽi9h'e0p}Y-+X&4Sed(&(Wvm3K ?rLYs?f~{]2ml]QCwP|[֞И`^GۀoD 'oSiuם V])x?6Wh5x Nr )e7=[eWZWc\g=PҲXrÂ$J=H-f&Ms9U|6_.RصdUNMB $0OwZ#ƭ ]|_"P$M' 2Pl͘bՇ7uqG4'zBޜYz Z~W*ݥm95n(3V4: ǔWX4ቿ+5WI\F6GWHPrƘ{$RpO! S6"yƖOeYeB\Ӣr+iڊʷv :--E7zc_\Mr<(17h.|MG5` Wϯ UϦ|L vr tJFEf6iIYINSAߌq*yɡ] iHơS=vt!S٣,֑ucU+Rra U F- -sԗH{`sHP2Wq$oOuV(D ?~*3aBd^o]>ȅbk4OdkBkSJEhQmꨮ+ hTaN@E9c{[^൹/ %r R{8-)hts©ʊDЊ֖| [Γ 61^4L"L)o5?'C 9-%,6,KIq܊ƴduTFcSp`3&zw͉k,쟓W(9q̈B fC45VUWB ye)Jv'A>.g#qR=*Hmqι-O%2m:°fwG8հ '"8WZN?N l{"O3(uhɏsDk9@q= !qѹn%pBA uDDJ)ramxԐGfjC]ip`2h+Zyu1x ]b1,? SV_b"lO`偶}x4K☎1"wcYgy^]6qCU^ k!Qs)i&4/4`Ԁyf M*(mI%暸79)e-4cEJCAs9kvm~u=Yo_7%z_N'BrPr+RwͭGĸЛSs B 'wYX,K`uvyE6A9v44E#A@Ô´ K D-ѹyGhd*.3dpSd2lgԂ?],Dy)w:|D,|*E>UyZZTgj>c`pfDJy.7dPrhZ1HQ 湲R"w,)-hú/5닋Rc-K~_:aAn9a/'{ ["_B9:[ '%d' >#Cs=&3/U^{||gk͛X㞋!|O WA6pI2FS<z8wQ| D4h>i f+d2-`L.vBհO&=pbd`7Kbn&=PQ!J6c=&r}C-!l/"">ZI1kܤkFKo o?4KcR$*v7SHᤧXS!yN!fl\x(ޮF8zθXr'Wk"pye!-diUHYc:\R9f8pRQo~WGܕL3kt7HnExفCƖ$ PF@YхяϧW+,6v]?ͩu'G?EΫ[,a clkf]dיoUN',kO/W)yיm33sL^ 'kԆqr[M۫?(M=$'NvIkCVI<R!ܐKIOЪPJu/iS.̩ovvCQ1jwTi=mb=@RS8tDef򶕼3KfożJR CzdrY` FE,3}˿ZBz 8CEGz kuճH׹8{du W?Q0>OpL0^_d+eH2,«-b(d1cR -[nm=h*e-2,JZn]5V/r\:Nq߷6ːGh*#O nL0xa~])͝N0 LD483 4|_RIsARda*bxvCP$%4Y%pް6w}C(Mv3rʲuΜ"Ẻbn?Y 0.)qP x.#k!CaB4B/TT7V8^@1cc > ӇqĨơĕJ͝j2Rbk֦[ kR[ !vlc!)ΞՖdאx$j{d G7` DR٪fU!>h+ ^8}(K&Ʈ:53C3e~xM_W9pow~#pC~;!6<<`Zh])0jee'(МD`m!̂Q{M|ڬ,)>XG7bhKWjKomev,WjTi:&Ikޚ>13 nYk*ZI|ze:Dֽ P,n}I{-Ҳ("BNA׿Y+GaH;>8A8 jN# ? ]O,Ŵܾ}6^%J/4f<~%qG k: uE:T=eLb^~!eQgxok+w:ł- 'vM*u {LauDp:Bu@gC:IAf'djw/,8!:9:ˎowM6f 3&.N;0*z>l.[ޕݍZەE1_`@x0%1/lyRيbB`b '˜OC &pFэ1JG)#?m4vBCdP߈dgzhopIX rS>Cɥ3=?Yt'wᝫ@]b&J8M2[(*e ۞"# W QkJJzBiL\DSH,u@Qr~ %1ٟ2ru+9GIJw(9cEmJhεIrs:9 ]ImCzI.O1>F9W]f#ܕF7=Z']]rj7NS‫^J|w[,I0d<"oK67o1{zsƶ&˿Ю_vPIM8ƚy3Ӯfّt dE7_2P+OjĠ9wIMf6*.d'u̳s=p` _9BQDĚ6?ći呭Z@pvm DxFyݕʜ 끔H/kt7z_E-Y&(6D*L;ʭ9yG;| Q=Ģ [ٱU3d\ڛ.W[L=~I)l6ވOI vM)8GJU)`FkQr]u#"Y8> DVMB?Pfq;' Mr\l>bz{ʿQu-6G&H 1Ý׷kr* &I"<;g7OҾ3?cwj ЛfC߼n, y$CͶ+6FGm$OB7C0^êݛQ^wrOcx Qde|e24m |?rjweki1C(M跊KL;)tsY/ox^#)˧79D?VRQQtv=yZ 8]Kr4m=:[Q*(N2 uNY\;mop 6Â`.ĝBP䲺V=xf^쐛qc a+eCk<=W j!, G\gW# 0bk1P!%sC. lܸꡁ pROe '&v0_Tjisbvi&0=e{X'RFl¬WIp$} v6@fz'ƅqYUE}/zeKWv̍#0BQ*dqdDI?CY3 愣9D;מX &5w|`fYk'_]jLmݏu*&Y-܅1 ̗o=~QF W컡t \ދGF'#d\Mq\gW[RjHc艺 㜸9]2,ڙwxeCt) J45ص!e!> B@N. # ۷UgP ;#bun\"GM5I0x3Pr8W?@7g%Bt@[@v 0aFܷœ nzF*<֨ӻhϠelEA A8; d/2AyPqnqّgl ViDs"U@}5FR5S#n*e5WkpͻŬF^c$vѭ}'4Lfqwf TG_ &; F <r;Xz}\+nsoVo, 慚7;<.CIzR|`?0)AGiqg8 $~ 󭀞dwoiD|}`O}Q|cP)B0-i (P\=e~&n+≰)HDMS@ mWp[D0ݓs| vqVY_$9zޅyJpܜ,{o"$#K4.Kt6*%_nV|_u WKTwCGf>"_/ MlYځZ +!_JƓ\ i 1/Iil}~㨥эb'`XzȈ<\*j'裯F]<@!2*׎ܠ*m.B Tۤua7?‹mzΟ+D8hf D7;97*ܺU%Sߣ>E9gK3{tX?,vb@_OwR$5fAcZFEmH Fqx܃Ā;HzD7&^<>ZRo\>.9+Pnk4IdhcF.4 zc|`ל;%#o9w/41p=Q7#g|IbtWI٩dN^)fN֨Mrb{0sg}:h7;" S_7!b.~ڧ3g:ZGKy?6KE#8$)>h\t2oC}oGH, =0iOyl&YE7yw*Rg T1d9&X+9tLJO¢.s.j8b8v}c$e73rv 4.McN8"NCp.} FM Qk3jLH#JćتI:G2Vi\]%:DQAaǟcM6M:kQb35z?4HJI&6V.[sΐtfK\.72˪g82 $ 2"hF,9)VӯVC/$shܶ2νC[*ŧHw_BvN/i؁ -Bp7R`NBߠ&_2t^q|+hԟFZdh$ R"2,~O}>Fo v|ß5܋x\.1*ziKUofNEzuu? 5 xo#ʘvPTԁ{\:VΌ)5Pz~VH4B]!I<(I` W\[,l2]zOV)C3}`paye^$w ?#v!Fg6&6w3g/65rpeGn~ztUKg 9WZ,-`'6|@H KOSv`_5 CƨEљ$wO'Al~iCşm'JՏ{Ԋy_/nPPB{PǫosFpT~ IL)S57j<'PCjUke6Q4A}Nf5dY:o/p:ၹN.!_jv \g-LHntsËצQS6`oJWh.A=j-`q RßqlE)R1aŅy)VC~jYs-|,/ j\j%B[H3Q;-x޹rm%!og6U5_5)mlJH9nr`J[2=xk I{)/>0L Ix'Nŏ>] x4}{RW;Lו6֒^Trf2eajPjC⍇k9Gq T,{j9Ñ)Wɻ: f#Tcz' k]%Nf7P!was߮lbl;O rSiRABiGe7J蹧ci bKY#UkH~@5"F^2or 7bQlzٶX>tZvAX[iݷk4 H p2BD5FotBh4/Ch3_(8ءdv)/(RN&E`ޚeBZiB5rFïȴ=5̺ܴ!4sTlŞ`PLEZho$`=ihlVl s_ڏt),W7ԾFJ<0FqCP||v}QUg#=01|GK zVMvO|-^Tކmeu]*F͘*ŰŽ7F[Kٻu4%M☪uAv+}~r_ @MσgrWT3G+s*Tز:_~5fj8;%+T@#~LZ O3E& {8`?g wt:) WLo7:,F_]{(,_mprIx"vO#x`;ql]c%@е ,dgnvDMZBu E_q-a>a<똵 eTHP? bZ8plfv++LٽBRTx*ڃ.LBmVq TW7S /)s; KZXh\i]𠾁ٍ授L{( n^dK>f\|^1=Ҍ1wۢu4o|ȏn/Hސ17UBۖޣȧiFadqNQn>=5݂<:b51|Iavp'#/1e EhBdz { _/ĕ" Rǰrvkʒ`يV ECir؂K>jl{9;7ާZ~tuR9a6oEmR;4)DjX|q`w:Ajj*{9aaԼd .G|"J[ak9,HAf䙺PJ#m[T ^3xЧTݎbY-,8P/ ,N'16e-?b#֨]g`q1hGbZ3iG'}YՆGo,$؇`QiHq Q8Pm=/3V"k?~1 (Boy.yu-U"iLD2c_FM Juflwv1're7RSra2d(q^eHǤsaQ'FLR[$G7J-aU]Wt2gʴhj/GZ͖U/d}~`9c|'SLj2$p}Yk==>jfF]@%Y)&BϹ2*Ry{^<%(M1#_!AG$\Ԗy~kQlUk\goD1V @(hj=D M\(aL/x~ءP-L 0aD1kE3]ՁdD}Tcu>&ś׀MX> X.H[)9&e $ iCB"r&{k ;p'(1 0n!/_u8GKIK1|~[ƃ3yAThEEYd^;%ă5aBCLmr.Hiʭ7zrSI@g;c=ed}h5Ϩ$C2aNX#w}P8:LO`vIB}M(܊12-t >x3Pgoa(g/wW\Et+u h5l.&QV5ss@vp/QPj9 N p"U`MK?gĀӰrb~:&>baMZ swQ&FZOJ:3 6&e~sq',{heH="f QXrUS[EѿrS'6Ϧ^}l3K\m_VG)k8DTM4,v2!PFTf3U endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 792 /Length 3156 /Filter /FlateDecode >> stream xZ[s6~ׯc4;;1iq6Lʒ+R_ $۲>ulw.$H1T,ӎyK&2 hh&rT"GI'%SI7L9<ә#ZL)ULif4f3k3bN[T@,X) R_82S\= +ez*q1126Lb54 f,ԂVY{(c3\Yd’2\}U3Lƍ̘#,B(q2ϠsX^ALBiRO`4p=TYgb(^2-!֣ @yB* Vϡ$'sr΁<"7ZK@FVg0Tk0 5c{ڀ1T"A  l= `*PKLITqd9TgJCM5乙7sxG2~87 1izzϟ3~C*h:>޳Yqsŭ㢪_+k^O|zY! Ϫ͸d7*'uyhrvCEǣ!@iVav^Y1zTUd0s$|\^Hw"wDC0cmA]PP]!<]of䵌}`hT{e/ 6+$Hj: ˊR]9.G}A~{VRдD" $v2϶a^6p{'"uC("120Bg HJ0" T)ĪcR]32%txR lqxiy[%F2YHD2Fjh$_hc]|BF=VmF"CFI;Qb9wDĝu m\7bjGblec=c+FqZR摊ڝ}Ek)TG9fō&nѧg:HExkv7R=JCS.$:np_`?Vc.\Lyg|̿֡Ieg#Rka/M ⬃:aSY&R+k{s0gU⪘aoVy}U6 r2ӎ&O~EvE݄]f!x oȠr$cAE[7șgK2iv)Tsj`9cL S橜fXa @5O$6x@O#83vSBBcmNG㹔~M+6}5+ I B<%Гf$Raj3B,sE=.Z1fas5Z2`PgD0F薭D6M=KAPxkRDڑ豌=˂٣Zy(#p7zZ66Q"'W\7t'ҍZ @,YUoY/T64)8CyhhT c8SMn0C2bo9…(Pޅ f =,Z˚3b6 8zE,I)&ESÄZG!7~bJCɠ>kuM {%-hI'DesKz,cSp*jgdC@,}!&1KEf*_H^\hK@MT` VxִV&nRMd1Vx*\YqL!=PI:@L2iNxr L*cAOwJMu4?Xdt%Ka4G;(@l]s0թ 2JCJf FbuFnۮKgH֜6dq2M3QF:{òF7t7/qy8>et{w֞ !(`_ i{$}Hq}9B3Ƕ؞u1 '㒁I]^HzSZ2Gz_C~K~/1>Io m3Ek3ohzg5feߦ|oQ+C޽J `B)-#@=`o;v?p:NP^_|:3  0o 0%>+u>Mƨo Wny5.q-(gK],u`)RȨ`>CzL0 ^LxqXBtQ@ᧃ| 0-0^#Oj`jÐuHɪ5jvGJd'oNOE( ]c+JSsrU=(m"B?hq br':+uT3bḸh1rVu9k2ݸbf;NbV$1y8+-Tyhm!!i>%nںOG_7Qᶘu֕(>$n> nڮOvާMphΜ< ^IkNgP\Mņ~$Z8)Ն~Б+wKu;7X֙XYKpդۈ⦀Blx}QszًI؊hey<=/Ǫl黛rϢS貴 endstream endobj 120 0 obj << /Producer (pdfTeX-1.40.20) /Author()/Title()/Subject()/Creator(LaTeX with hyperref)/Keywords() /CreationDate (D:20211026173507-04'00') /ModDate (D:20211026173507-04'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.20 (TeX Live 2019/Debian) kpathsea version 6.3.1) >> endobj 121 0 obj << /Type /XRef /Index [0 122] /Size 122 /W [1 3 1] /Root 119 0 R /Info 120 0 R /ID [<502D33116BDE521B9C0F88D13790932E> <502D33116BDE521B9C0F88D13790932E>] /Length 296 /Filter /FlateDecode >> stream x%Y.asLS-Eklњn,H,A\H$x_|oWD!Pp Cȁ\'4>C `aJa2Qn9T*$a)X4xVuiAԫx5@4xomk.T=qnz}*KaP\`H%m0J2lۨJjIi œJ>>= library("graph") library("cluster") data(ruspini) pm <- pam(ruspini, 4) cG <- new("clusterGraph", clusters = split(names(pm$clustering), pm$clustering)) nodes(cG) @ We now have a graph that we could perform various operations on. For example, we could try a second clustering algorithm on the same data and see if the two largely agree. <>= library(stats) km = kmeans(ruspini, 4) cG.km = new("clusterGraph", clusters=split(as.character(1:75), km$cluster)) inBoth = intersection(cG.km, cG) @ The graph \Robject{inBoth} is of length \Sexpr{length(inBoth)} indicating that there are that many distinct groups. One could, compute various measures of correspondence between the two clustering algorithms using the graph representation. \section*{distGraph} We use this same data to consider some potential uses for the \Rclass{distGraph} class. Others have considered a similar structure for exploring clustering algorithms. %%FIXME: track down the Butte et al and the Shamir references <<>>= d1 = dist(ruspini) dG = new("distGraph", Dist=d1) rl = NULL j=1 for(i in c(40, 30, 10, 5) ){ nG = threshold(dG, i) rl[[j]] = connComp(nG) j=j+1 } @ We can then examine the components of \Robject{rl} to see how the graph is being reduced. <>= sapply(rl, length) @ <>= dr = range(d1) rl.lens = sapply(rl[[4]], length) @ We see that when we remove all distances that are bigger than 5 units (the range of distances was from \Sexpr{round(dr[1], 3)} to \Sexpr{round(dr[2],3)}) there are still only \Sexpr{length(rl[[4]])} connected components - one of which is of size \Sexpr{max(rl.lens)}. \end{document} graph/inst/unitTests/0000755000175000017500000000000014136046755014477 5ustar nileshnileshgraph/inst/unitTests/graphAM_test.R0000644000175000017500000004215314136046755017205 0ustar nileshnileshsimpleAdjMat <- function() { ## Here's a simple graph for testing ## a b ## |\ /| ## | \___c___/ | ## | | | ## \ | / ## \____d____/ ## ## mat <- matrix(c(0, 0, 1, 1, 0, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0), byrow=TRUE, ncol=4) rownames(mat) <- letters[1:4] colnames(mat) <- letters[1:4] mat } simpleDirectedGraph <- function() { ## Here's a simple graph for testing ## a b ## |\ /^ ## | \__>c<__/ | ## | ^ | ## \ | / ## \___>d____/ ## ## mat <- matrix(c(0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 1, 0), byrow=TRUE, ncol=4) rownames(mat) <- letters[1:4] colnames(mat) <- letters[1:4] mat graphAM (adjMat=mat, edgemode="directed") } testConstructorFunction <- function() { ## no-argument constructor adjMat <- matrix(integer(), 0, 0) target <- new("graphAM", adjMat=adjMat) checkIdentical(target, graphAM()) ## adjMat constructor adjMat <- simpleAdjMat() target <- new("graphAM", adjMat=adjMat, edgemode="directed") checkIdentical(target, graphAM(adjMat, "directed")) target <- new("graphAM", adjMat=adjMat, edgemode="undirected") checkIdentical(target, graphAM(adjMat, "undirected")) checkIdentical(target, graphAM(adjMat)) ## values: adjacency matrix non-zero (and necessarily positive) values ## will be used as edge weights, an edge attribute. the -1 is ignored ## in all cases, but retrievable via edgeDataDefaults ## values is to contain exactly one name, and one value ## the name indicates the edge attribute, whose values come from the ## elements of the adjacency matrix: often, but not necessarily, set to 1 values <- list(weight=-1) target <- new("graphAM", adjMat=adjMat, edgemode="directed", values=values) checkEquals (edgeData(target, 'a', 'c', attr='weight')[[1]], 1) checkEquals (edgeDataDefaults(target, 'weight'), -1) checkIdentical(target, graphAM(adjMat, "directed", values)) } testInvalidNonSquare <- function() { mat <- cbind(c(0, 0, 1), c(1, 1, 1)) checkException(graphAM (adjMat=mat), silent=TRUE) } testInvalidNegativeValues <- function() { mat <- matrix(c(0, 1, -4, -1), ncol=2) checkException(graphAM (adjMat=mat), silent=TRUE) } testInvalidNonSymmetric <- function() { mat <- matrix(c(0, 1, 1, 0, 0, 1, 0, 0, 0), ncol=3, byrow=TRUE) colnames(mat) <- letters[1:3] checkException(graphAM (adjMat=mat), silent=TRUE) checkException(graphAM (adjMat=mat, edgemode="undirected"), silent=TRUE) g1 <- graphAM (adjMat=mat, edgemode="directed") } testInvalidBadNodeNames <- function() { mat <- simpleAdjMat() n <- paste(letters[1:4], 1:4, sep=graph:::EDGE_KEY_SEP) colnames(mat) <- rownames(mat) <- n checkException(graphAM (adjMat=mat), silent=TRUE) colnames(mat) <- rownames(mat) <- c("a", "b", NA, "c") checkException(graphAM (adjMat=mat), silent=TRUE) colnames(mat) <- rownames(mat) <- c("a", "f", "", "d") checkException(graphAM (adjMat=mat), silent=TRUE) } test_empty_graph <- function() { mat <- matrix(integer(0), nrow=0, ncol=0) g <- graphAM (adjMat = mat) checkEquals(0L, numNodes(g)) checkEquals(0L, numEdges(g)) checkEquals(character(0), nodes(g)) checkEquals(list(), edges(g)) m <- as(g, "matrix") checkEquals(c(0L, 0L), dim(m)) checkEquals(0L, length(m)) g <- graphAM (adjMat = mat, values = list(weight = 1L)) checkEquals(0L, numNodes(g)) checkEquals(0L, numEdges(g)) checkEquals(character(0), nodes(g)) checkEquals(list(), edges(g)) m <- as(g, "matrix") checkEquals(c(0L, 0L), dim(m)) checkEquals(0L, length(m)) } test_no_edge_graph <- function() { mat <- matrix(0L, nrow=3, ncol=3, dimnames=list(letters[1:3], letters[1:3])) g <- graphAM (adjMat = mat) checkEquals(letters[1:3], nodes(g)) checkEquals(0L, numEdges(g)) want <- list(a = character(0), b = character(0), c = character(0)) checkEquals(want, edges(g)) m <- as(g, "matrix") checkEquals(c(3L, 3L), dim(m)) checkTrue(all(m == 0L)) g <- graphAM (adjMat = mat, values = list(weight = 1L)) checkEquals(letters[1:3], nodes(g)) checkEquals(0L, numEdges(g)) checkEquals(want, edges(g)) m <- as(g, "matrix") checkEquals(c(3L, 3L), dim(m)) checkTrue(all(m == 0L)) } testValuesToAttr <- function() { mat <- matrix(c(0, 0, 1, 2, 0, 0, 3, 0, 0, 0, 0, 0, 0, 4, 5, 0), byrow=TRUE, ncol=4) rownames(mat) <- letters[1:4] colnames(mat) <- letters[1:4] g1 <- graphAM (adjMat=mat, edgemode="directed", values=list(weight=1)) checkEquals(4, edgeData(g1, "d", "b", attr="weight")[[1]]) checkEquals(3, edgeData(g1, "b", "c", attr="weight")[[1]]) checkEquals(2, edgeData(g1, "a", "d", attr="weight")[[1]]) checkEquals(1, edgeData(g1, "a", "c", attr="weight")[[1]]) checkException(graphAM (adjMat=mat, edgemode="directed", values=list(weight=1, not=2)), silent=TRUE) checkException(graphAM (adjMat=mat, edgemode="directed", values=list("must", "name")), silent=TRUE) checkException(graphAM (adjMat=mat, edgemode="directed", values="weight"), silent=TRUE) g1 <- graphAM (adjMat=mat, edgemode="directed", values=list(type=4)) checkEquals(4, edgeData(g1, "d", "b", attr="type")[[1]]) checkEquals(3, edgeData(g1, "b", "c", attr="type")[[1]]) checkEquals(2, edgeData(g1, "a", "d", attr="type")[[1]]) checkEquals(1, edgeData(g1, "a", "c", attr="type")[[1]]) } testEdges <- function() { mat <- simpleAdjMat() g1 <- graphAM (adjMat=mat) got <- edges(g1) expect <- list(a=c("c", "d"), b=c("c", "d"), c=c("a", "b", "d"), d=c("a", "b", "c")) checkEquals(expect, got) got <- edges(g1, c("a", "d")) expect <- expect[c("a", "d")] checkEquals(expect, got) } testEdgesDirected <- function() { g1 <- simpleDirectedGraph() expect <- list(a=c("c", "d"), b="c", c=character(0), d=c("b", "c")) checkEquals(expect, edges(g1)) } testEdgesSubset <- function() { mat <- simpleAdjMat() g1 <- graphAM (adjMat=mat) got <- edges(g1) expect <- list(a=c("c", "d"), d=c("a", "b", "c")) got <- edges(g1, c("a", "d")) checkEquals(expect, got) } testNodeNames <- function() { mat <- simpleAdjMat() g1 <- graphAM (adjMat=mat) got <- nodes(g1) expect <- letters[1:4] checkEquals(expect, got) } testNodeNamesReplace <- function() { mat <- simpleAdjMat() g1 <- graphAM (adjMat=mat) nodes(g1) <- LETTERS[1:4] expect <- LETTERS[1:4] checkEquals(expect, nodes(g1)) } testNumNodes <- function() { mat <- simpleAdjMat() g1 <- graphAM (adjMat=mat) checkEquals(nrow(mat), numNodes(g1)) } testNumEdges <- function() { mat <- simpleAdjMat() g1 <- graphAM (adjMat=mat) checkEquals(5, numEdges(g1)) edgemode(g1) <- "directed" checkEquals(10, numEdges(g1)) } testNumEdgesWithSelfLoop <- function() { mat <- matrix(c(1, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 0, 0, 0), ncol=4) g1 <- graphAM (adjMat=mat) checkEquals(4, numEdges(g1)) } testIsAdjacent <- function() { mat <- simpleAdjMat() g1 <- graphAM (adjMat=mat) checkEquals(TRUE, isAdjacent(g1, "a", "c")) checkEquals(TRUE, isAdjacent(g1, "c", "a")) checkEquals(FALSE, isAdjacent(g1, "a", "b")) checkEquals(FALSE, isAdjacent(g1, "b", "a")) checkException(isAdjacent(g1, "z", "a"), silent=TRUE) checkException(isAdjacent(g1, "a", "z"), silent=TRUE) } testIsAdjacentVectorized <- function() { mat <- simpleAdjMat() g1 <- graphAM (adjMat=mat) fr <- c("a", "c", "a", "b") to <- c("c", "a", "b", "a") expect <- c(TRUE, TRUE, FALSE, FALSE) checkEquals(expect, isAdjacent(g1, fr, to)) checkEquals(expect, isAdjacent(g1, to, fr)) } ## testSubgraph <- function() { ## mat <- simpleAdjMat() ## g1 <- graphAM (adjMat=mat) ## g2 <- subgraph(c("a", "b", "c"), ffff) ## } testSimpleEdgeWeights <- function() { mat <- simpleAdjMat() g <- graphAM (mat) checkEquals(nodes(g), names(edgeWeights(g))) expect <- c(c=1:1, d=1:1) checkEquals(expect, edgeWeights(g)$a) } testAddNode <- function() { mat <- simpleAdjMat() g1 <- graphAM (adjMat=mat) newNodes <- c("r", "s", "a", "b") checkException(addNode(newNodes, g1), silent=TRUE) newNodes <- c("r", "s") expect <- c(nodes(g1), newNodes) g1 <- addNode(newNodes, g1) checkEquals(expect, nodes(g1)) badNodeName <- paste("foo", graph:::EDGE_KEY_SEP, "bar", sep="") checkException(addNode(badNodeName, g1), silent=TRUE) } testAddEdge <- function() { ## I would like different order of the args in the generic, but not sure it is ## worth it to change... but would seem more consistent. mat <- simpleAdjMat() g1 <- graphAM (adjMat=mat) g1 <- addNode("e", g1) checkEquals(FALSE, isAdjacent(g1, "b", "e")) g1 <- addEdge(graph=g1, from="b", to="e") checkEquals(TRUE, isAdjacent(g1, "b", "e")) } testAddEdgeMultiple <- function() { a <- matrix(0L, nrow=8, ncol=8) dimnames(a) <- list(letters[1:8], letters[1:8]) G <- graphAM (adjMat=a, edgemode = "directed") GU <- graphAM (adjMat=a) ## make sure we don't warn for this call tryCatch({ H <- addEdge(from=c("a", "b", "c"), to=c("d", "e", "f"), G) HU <- addEdge(from=c("a", "b", "c"), to=c("d", "e", "f"), GU) }, warning = function(w) stop("unwanted warning message: ", conditionMessage(w))) expect <- a fr <- c("a", "b", "c") to <- c("d", "e", "f") wh <- cbind(match(fr, letters[1:8]), match(to, letters[1:8])) expect[wh] <- 1L checkEquals(expect, as(H, "matrix")) expectU <- expect expectU[wh[ , c(2L, 1L)]] <- 1L checkEquals(expectU, as(HU, "matrix")) } testClearNode <- function() { mat <- simpleAdjMat() g1 <- graphAM (adjMat=mat) edgeDataDefaults(g1, attr="weight") <- 1 edgeData(g1, "a", "c", attr="weight") <- 400 checkEquals(TRUE, isAdjacent(g1, "a", "c")) checkEquals(TRUE, isAdjacent(g1, "a", "d")) checkEquals(400, edgeData(g1, "a", "c", attr="weight")[[1]]) g1 <- clearNode("a", g1) checkEquals(FALSE, isAdjacent(g1, "a", "c")) checkEquals(FALSE, isAdjacent(g1, "a", "d")) checkException(edgeData(g1, "a", "c", attr="weight"), silent=TRUE) } testRemoveNode <- function() { mat <- simpleAdjMat() g1 <- graphAM (adjMat=mat) origNodes <- nodes(g1) checkEquals(TRUE, "b" %in% origNodes) g1 <- removeNode("b", g1) checkEquals(FALSE, "b" %in% nodes(g1)) } testRemoveEdge <- function() { mat <- simpleAdjMat() g1 <- graphAM (adjMat=mat) checkEquals(TRUE, isAdjacent(g1, "a", "c")) g1 <- removeEdge("a", "c", g1) checkEquals(FALSE, isAdjacent(g1, "a", "c")) } testRemoveEdgeWithWeights <- function() { mat <- simpleAdjMat() mat[mat != 0] <- runif(length(mat[mat != 0])) g <- graphAM (adjMat = mat, edgemode = "directed", values = list(weight = 1.0)) weights <- unlist(edgeData(g, attr = "weight")) toRemove <- names(weights[weights < 0.5]) expect <- numEdges(g) - length(toRemove) fromTo <- do.call(rbind, strsplit(toRemove, "|", fixed = TRUE)) g2 <- removeEdge(fromTo[, 1], fromTo[, 2], g) checkEquals(expect, numEdges(g2)) apply(fromTo, 1, function(row) { checkEquals(FALSE, isAdjacent(g2, row[1], row[2])) }) } testGraphAMCloning <- function() { mat <- simpleAdjMat() g1 <- graphAM (adjMat=mat) origNodes <- nodes(g1) g2 <- g1 ## modify g1 g1 <- addNode("NEW", g1) edgeDataDefaults(g1, "weight") <- 2 edgeDataDefaults(g1, "color") <- "green" ## g2 should not have changed checkEquals(list(), edgeDataDefaults(g2)) checkEquals(origNodes, nodes(g2)) } testUndirectedAsGraphNEL <- function() { mat <- simpleAdjMat() g1 <- graphAM (adjMat=mat) gNel <- as(g1, "graphNEL") checkEquals(edges(g1), edges(gNel)) checkEquals(nodes(g1), nodes(gNel)) checkEquals(edgemode(g1), edgemode(gNel)) checkEquals(edgeDataDefaults(g1), edgeDataDefaults(gNel)) checkEquals(nodeDataDefaults(g1), nodeDataDefaults(gNel)) } testDirectedAsGraphNEL <- function() { g1 <- simpleDirectedGraph() gNel <- as(g1, "graphNEL") checkEquals(edges(g1), edges(gNel)) checkEquals(nodes(g1), nodes(gNel)) checkEquals(edgemode(g1), edgemode(gNel)) checkEquals(edgeDataDefaults(g1), edgeDataDefaults(gNel)) checkEquals(nodeDataDefaults(g1), nodeDataDefaults(gNel)) } testDirectedAsGraphAM <- function() { g1 <- simpleDirectedGraph() gNel <- as(g1, "graphNEL") g2 <- as(gNel, "graphAM") checkEquals(edges(g1), edges(g2)) checkEquals(nodes(g1), nodes(g2)) checkEquals(edgemode(g1), edgemode(g2)) checkEquals(edgeDataDefaults(g1), edgeDataDefaults(g2)) checkEquals(nodeDataDefaults(g1), nodeDataDefaults(g2)) } testInEdges <- function() { g1 <- simpleDirectedGraph() expected <- list(a=character(0), b="d", c=c("a", "b", "d"), d="a") checkEquals(expected, inEdges(g1), msg="gramAM") checkEquals(expected, inEdges(object=g1), msg="gramAM") checkEquals(expected, inEdges(node=g1), msg="gramAM") } testNoEdges <- function() { m <- matrix(0, nrow=3, ncol=3) g <- graphAM (m) checkEquals(0, numEdges(g)) checkEquals(3, length(edges(g))) checkEquals(nodes(g), names(edges(g))) checkEquals(0, sum(sapply(edges(g), length))) } testAsMatrix <- function() { mat <- rbind(c(0, 0, 12, 1), c(0, 0, 1, 1), c(12, 1, 0, 1), c(1, 1, 1, 0)) rownames(mat) <- colnames(mat) <- letters[1:4] ## If no values arg, then matrix just converted to 0/1 g1 <- graphAM (adjMat=mat, edgemode="undirected") mat1 <- mat mat1[mat1 != 0] <- 1:1 checkEquals(mat1, as(g1, "matrix")) ## With values arg, matrix values stored as edge attribute ## which gets restored for as(<.>, "matrix") g2 <- graphAM (adjMat=mat, edgemode="undirected", values=list(weight=1)) checkEquals(mat, as(g2, "matrix")) } test_coerce_matrix_to_graphAM <- function() { mat <- matrix(c(0, 0, 1, 2, 0, 0, 3, 0, 0, 0, 0, 0, 0, 4, 5, 0), byrow=TRUE, ncol=4, dimnames=list(letters[1:4], letters[1:4])) g <- as(mat, "graphAM") checkEquals(mat, as(g, "matrix")) g2 <- graphAM (adjMat=mat, edgemode="directed", values=list("weight"=1)) checkEquals(as(g, "matrix"), as(g2, "matrix")) } test_edgeMatrix <- function() { ugam <- graphAM (adjMat=simpleAdjMat(), edgemode="undirected") gam <- simpleDirectedGraph() expect <- c("1+3", "1+4", "2+3", "2+4", "3+4") got <- edgeMatrix(ugam) checkTrue(setequal(expect, paste(got[1, ], got[2, ], sep="+"))) checkEquals(list(c("from", "to"), NULL), dimnames(got)) expect <- c("1+3", "1+4", "2+3", "4+2", "4+3") got <- edgeMatrix(gam) checkTrue(setequal(expect, paste(got[1, ], got[2, ], sep="+"))) ## duplicates should have no effect on directed graph got <- edgeMatrix(gam, duplicates=TRUE) checkTrue(setequal(expect, paste(got[1, ], got[2, ], sep="+"))) expect <- c("1+3", "1+4", "2+3", "2+4", "3+4", "3+1", "4+1", "3+2", "4+2", "4+3") got <- edgeMatrix(ugam, duplicates=TRUE) checkTrue(setequal(expect, paste(got[1, ], got[2, ], sep="+"))) } test_rename_nodes_edgeWeights <- function() { mat <- matrix(c(0, 0, 1, 2, 0, 0, 3, 0, 0, 0, 0, 0, 0, 4, 5, 0), byrow=TRUE, ncol=4) rownames(mat) <- letters[1:4] colnames(mat) <- letters[1:4] g <- graphAM (adjMat=mat, edgemode="directed", values=list(weight=1)) ew <- edgeWeights(g) ew <- lapply(ew, function(x) { if (length(x)) names(x) <- toupper(names(x)) x }) names(ew) <- toupper(names(ew)) nodes(g) <- LETTERS[1:4] checkEquals(LETTERS[1:4], nodes(g)) checkEquals(ew, edgeWeights(g)) } test_rename_nodes_nodeData <- function() { g <- simpleDirectedGraph() nodeDataDefaults(g) <- list(type=NA) nodeData(g, n="a", attr="type") <- "the first one" nodeData(g, n="d", attr="type") <- "the last one" ndDef <- nodeDataDefaults(g) nd <- nodeData(g, attr="type") names(nd) <- toupper(names(nd)) nodes(g) <- toupper(nodes(g)) checkEquals(nd, nodeData(g, attr="type")) } test_simple_AM = function() { adjm <- matrix(c(0,1,1,0), nrow=2) # this matrix has exactly one entry in each row obj <- graphAM(adjMat=adjm, edgemode="directed") validObject(obj) } test_simple_AM2 = function() { adjm <- matrix(c(0,1,1, 1,0,1, 0,1,1), nrow=3, byrow=TRUE) # this matrix has exactly two entries in each row obj <- graphAM(adjMat=adjm, edgemode="directed") validObject(obj) } graph/inst/unitTests/simple_sparse_test.R0000644000175000017500000000141514136046755020530 0ustar nileshnilesh.indexToCoord <- graph:::.indexToCoord .coordToIndex <- graph:::.coordToIndex set.seed(0x389d) check_coord_txfm <- function(n) { n <- as.integer(n) seqn <- seq_len(n) seqnn <- seq_len(n * n) coord <- cbind(rep(seqn, n), rep(seqn, each = n)) index <- .coordToIndex(coord[ , 1L], coord[, 2L], n) checkEquals(seqnn, index) got_coord <- .indexToCoord(seqnn, n) checkEquals(coord, got_coord) ## now check order preservation p1 <- sample(seqnn) p1coord <- coord[p1, ] if (n == 1L) { dim(p1coord) <- c(1L, 2L) } checkEquals(p1, .coordToIndex(p1coord[,1L], p1coord[,2L], n)) checkEquals(p1coord, .indexToCoord(p1, n)) } test_coordinate_txfm <- function() { for (i in 1:25) { check_coord_txfm(i) } } graph/inst/unitTests/leaves_test.R0000644000175000017500000000122414136046755017137 0ustar nileshnileshlibrary("graph") data(apopGraph) data(graphExamples) test_leaves_undirected <- function() { want <- "c" checkEquals(want, leaves(graphExamples[[1]])) } test_leaves_directed_in <- function() { want <- c("trkA", "CASP2", "CASP6", "DNA fragmentation", "Nucleus", "CASP9", "TRF3", "CASP10") checkTrue(setequal(want, leaves(apopGraph, degree.dir="out"))) } test_leaves_directed_in <- function() { want <- c("TNFa", "TNFb", "FasL", "CD40L", "FAP-1", "NGF", "Daxx", "Bax", "CASP4", "Glucocorticoid", "Mtd", "Bad", "CASP11", "Bcl-w") checkTrue(setequal(want, leaves(apopGraph, degree.dir="in"))) } graph/inst/unitTests/MultiGraph_test.R0000644000175000017500000013324514136046755017745 0ustar nileshnileshset.seed(0x12a9b) ## alias subsetEdgeSets; remove once it is exported make_directed_MultiGraph <- function(use.factors = TRUE) { ft1 <- data.frame(from=c("a", "a", "a", "b", "b"), to=c("b", "c", "d", "a", "d"), weight=c(1, 3.1, 5.4, 1, 2.2), stringsAsFactors = use.factors) ft2 <- data.frame(from=c("a", "a", "a", "x", "x", "c"), to=c("b", "c", "x", "y", "c", "a"), weight=c(3.4, 2.6, 1, 1, 1, 7.9), stringsAsFactors = use.factors) esets <- list(e1=ft1, e2=ft2) g <- MultiGraph(esets) list(esets=esets, g=g) } make_mixed_MultiGraph <- function(use.factors = TRUE) { ft1 <- data.frame(from=c("a", "a", "a", "b", "b"), to=c("b", "c", "d", "a", "d"), weight=c(1, 3.1, 5.4, 1, 2.2), stringsAsFactors = use.factors) ft2 <- data.frame(from=c("a", "a", "a", "x", "x", "c"), to=c("b", "c", "x", "y", "c", "a"), weight=c(3.4, 2.6, 1, 1, 1, 7.9), stringsAsFactors = use.factors) ft3 <- data.frame(from=c("a", "a", "x", "x", "x"), to =c("b", "c", "a", "y", "c"), weight=c(1:5), stringsAsFactors = use.factors) esets <- list(e1=ft1, e2=ft2, e3=ft3, e4=ft2[FALSE, ], e5=ft3[FALSE, ]) g <- MultiGraph(esets, directed = c(TRUE, TRUE, FALSE, TRUE, FALSE)) list(esets=esets, g=g) } randMultiGraph <- function(numNodes, numEdges) { ftlist <- lapply(numEdges, function(ne) { graph:::randFromTo(numNodes, ne) }) nn <- ftlist[[1L]]$nodes edgeSets <- lapply(ftlist, function(x) x[["ft"]]) names(edgeSets) <- paste("e", seq_len(length(edgeSets)), sep="") MultiGraph(edgeSets, nodes = nn) } randFromTo2 <- function(numNodes, numEdges, weightFun = function(N) rep(1L, N), directed = TRUE) { if (numNodes > 2^15) stop("too many nodes: ", numNodes) maxEdges <- numNodes * numNodes nodeNames <- sprintf("%010d", seq_len(numNodes)) x <- c(rep(1L, numEdges), rep(0L, maxEdges - numEdges)) idx <- which(sample(x) == 1L) to_i <- ((idx - 1L) %/% numNodes) + 1L from_i <- ((idx - 1L) %% numNodes) + 1L from <- nodeNames[from_i] to <- nodeNames[to_i] w <- weightFun(length(from)) if (!directed) { tmp <- graph:::.mg_undirectEdges(from, to, w) from <- tmp$from to <- tmp$to w <- tmp$weight df <- data.frame(from = from, to = to, weight = w, stringsAsFactors = FALSE) df <- df[!duplicated(df), ] } else { df <- data.frame(from = from, to = to, weight = w, stringsAsFactors = FALSE) } list(nodes = nodeNames, ft = df) } sort_esets <- function(esets) { ## sorting is based on column major ordering lapply(esets, function(ft) { ft <- ft[order(ft$to, ft$from), ] }) } make_unique_ft <- function(ftdata) { ## ftdata is a list with components $nodes and $ft ## $ft is a data.frame with columns 'from', 'to', and 'weight' ft <- ftdata[["ft"]] el <- paste(ft[["from"]], ft[["to"]], sep = "\t") dups <- duplicated(el) ftdata[["ft"]] <- ft[!dups, ] ftdata } test_basic_accessors <- function() { basic <- make_mixed_MultiGraph() esets <- basic$esets g <- basic$g checkEquals(6L, numNodes(g)) checkEquals(c("a", "b", "c", "d", "x", "y"), nodes(g)) checkEquals(c(e1=5L, e2=6L, e3=5L, e4=0L, e5=0L), numEdges(g)) checkEquals(structure(c(TRUE, TRUE, FALSE, TRUE, FALSE), .Names = paste("e", 1:5, sep="")), isDirected(g)) } test_no_edge_sets <- function() { g1 <- MultiGraph(list(), nodes = letters) g2 <- MultiGraph(list(), nodes = letters, directed = FALSE) for (g in list(g1, g2)) { checkEquals(26L, numNodes(g)) checkEquals(letters, nodes(g)) checkEquals(list(), numEdges(g)) checkEquals(list(), eweights(g)) checkEquals(list(), eweights(g, "=")) checkEquals(list(), isDirected(g)) } tcon = textConnection(NULL, "w") sink(tcon) show(g1) sink() checkEquals("MultiGraph with 26 nodes and 0 edge sets", textConnectionValue(tcon)) close(tcon) } test_create_empty_edgeSets <- function() { df1 <- data.frame(from=c("a", "b"), to=c("b", "c"), weight=c(1, 1), stringsAsFactors = TRUE) esets <- list(e1 = df1, empty1 = df1[FALSE, ]) g <- MultiGraph(esets) checkEquals(c(e1=2L, empty1=0L), numEdges(g)) dg <- MultiGraph(esets, directed = FALSE) checkEquals(c(e1=2L, empty1=0L), numEdges(dg)) } test_edgeSets_arg_checking <- function() { ## data.frame's in edgeSets list must have names: ## from, to, weights df0 <- data.frame(fr=c("a", "b"), to=c("b", "c"), weights=c(1, 1), stringsAsFactors = TRUE) checkException(MultiGraph(list(e1=df0))) ## edgeSets must be named list or empty list checkException(MultiGraph(NULL)) checkException(MultiGraph(list( data.frame(from=c("a", "b"), to=c("b", "c"), weights=c(1, 1), stringsAsFactors = TRUE) ))) } test_no_nodes <- function() { mg <- MultiGraph(list()) checkEquals(0L, length(nodes(mg))) checkEquals(list(), numEdges(mg)) } test_create_infer_nodes <- function() { basic <- make_directed_MultiGraph() esets <- basic$esets g <- basic$g checkEquals(6L, numNodes(g)) checkEquals(c(e1=5L, e2=6L), numEdges(g)) } ## test constructor with nodes arg given (singleton case) test_bad_nodes_in_create <- function() { basic <- make_directed_MultiGraph() esets <- basic$esets esets[[1]]$to <- as.character(esets[[1]]$to) bad_values <- c(NA, "a\n", "", "z|a", "a\t") for (v in bad_values) { tmp <- esets tmp[[1]]$to[3] <- v checkException(MultiGraph(tmp)) } } test_dup_edges_is_an_error <- function() { ## directed case ft1 <- data.frame(from=c("a", "a", "a"), to=c("b", "c", "b"), weight=c(1, 3.1, 5.4), stringsAsFactors = TRUE) checkException(MultiGraph(list(e1=ft1))) ## undirected case ft2 <- data.frame(from=c("a", "a", "b"), to=c("b", "c", "a"), weight=c(1, 3.1, 5.4), stringsAsFactors = TRUE) ## ok if directed junk <- MultiGraph(list(e1=ft2)) checkException(MultiGraph(list(e1=ft2), directed = FALSE)) } test_edgeWeights_create <- function() { basic <- make_mixed_MultiGraph() esets <- basic$esets g <- basic$g esets <- sort_esets(esets) got <- eweights(g) checkIdentical(list(e1 = esets[[1L]][, "weight"]), got[1]) checkIdentical(list(e2 = esets[[2L]][, "weight"]), got[2]) ## undirected case normalizes edges by sorting, always putting the ## node that sorts first as from. checkIdentical(list(e3 = c(1L, 2L, 3L, 5L, 4L)), got[3]) } test_edgeWeights_edge_names <- function() { basic <- make_mixed_MultiGraph() esets <- basic$esets g <- basic$g wv <- eweights(g, names.sep = "=>") esets <- sort_esets(esets) want <- paste(esets[[1]]$from, esets[[1]]$to, sep = "=>") checkEquals(want, names(wv[[1]])) want <- c("a|b"=1L, "a|c"=2L, "a|x"=3L, "c|x"=5L, "x|y"=4L) checkIdentical(list(e3 = want), eweights(g, "|")[3]) } test_supports_self_loops <- function() { esets <- list(e1 = data.frame(from = c("a", "a"), to = c("a", "b"), weight = c(1, 2), stringsAsFactors = TRUE)) g <- MultiGraph(esets) checkEquals(c(e1 = 2), numEdges(g)) } test_isDirected <- function() { g <- make_mixed_MultiGraph()$g checkEquals(c(e1=TRUE, e2=TRUE, e3=FALSE, e4=TRUE, e5=FALSE), isDirected(g)) } test_ugraph_via_isDirected <- function() { g <- make_mixed_MultiGraph()$g ## verify precondition want <- c(TRUE, TRUE, FALSE, TRUE, FALSE) names(want) <- paste("e", 1:5, sep="") checkEquals(want, isDirected(g)) ug <- ugraph(g) want[] <- FALSE checkEquals(want, isDirected(ug)) } test_ugraph_for_undirected_edge_sets <- function() { df1 <- data.frame(from=c("x", "a", "b"), to=c("a", "b", "x"), weight=c(1, 2, 3), stringsAsFactors = TRUE) g <- MultiGraph(list(e1=df1), directed=FALSE) ug <- ugraph(g) checkEquals(nodes(g), nodes(ug)) checkEquals(numEdges(g), numEdges(ug)) checkEquals(isDirected(g), isDirected(ug)) ## verify attributes have been dropped checkEquals(rep(1L, 3), eweights(ug)[[1]]) } test_ugraph_for_directed_edge_sets <- function() { df1 <- data.frame(from=c("x", "a", "b", "x", "b", "c"), to=c("a", "x", "x", "b", "a", "x"), weight=1:6, stringsAsFactors = TRUE) g <- MultiGraph(list(e1=df1), directed=TRUE) checkEquals(6, numEdges(g)[[1]]) ug <- ugraph(g) checkEquals(nodes(g), nodes(ug)) checkTrue(!isDirected(ug)[1]) checkEquals(4, numEdges(ug)[[1]]) checkEquals(rep(1L, 4), eweights(ug)[[1]]) checkEquals(c("a=b", "a=x", "b=x", "c=x"), names(eweights(ug, "=")[[1]])) } mg_equals <- function(g1, g2) { checkEquals(nodes(g1), nodes(g2)) checkEquals(isDirected(g1), isDirected(g2)) checkEquals(numEdges(g1), numEdges(g2)) checkEquals(eweights(g1, "==>"), eweights(g2, "==>")) } test_edgeSetIntersect0_trivial <- function() { ## Verify 0 and 1 edge set cases for directed/undirected df <- data.frame(from="a", to="b", weight=1L, stringsAsFactors = TRUE) mgs <- list( ## empty edge sets MultiGraph(list(), nodes = letters), MultiGraph(list(), nodes = letters, directed = FALSE), ## single edge set MultiGraph(list(e1=df)), MultiGraph(list(e1=df), directed = FALSE)) for (g in mgs) { mg_equals(g, edgeSetIntersect0(g)) } ## Verify empty intersection for disjoint graphs df1 <- data.frame(from="a", to="b", weight=1L, stringsAsFactors = TRUE) df2 <- data.frame(from="x", to="y", weight=1L, stringsAsFactors = TRUE) g <- MultiGraph(list(e1=df1, e2=df2)) gu <- MultiGraph(list(e1=df1, e2=df2), directed = FALSE) want <- MultiGraph(list(), nodes = c("a", "b", "x", "y")) mg_equals(want, edgeSetIntersect0(g)) mg_equals(want, edgeSetIntersect0(gu)) } # test_edgeSetIntersect0_directed_1 <- function() { ## non-trivial directed intersect g <- make_directed_MultiGraph()$g gi <- edgeSetIntersect0(g) ## TODO: do we want the minimal node set or not? ## checkEquals(c("a", "b", "c"), nodes(gi)) checkEquals(nodes(g), nodes(gi)) # original nodes checkEquals(c(e1_e2=2L), numEdges(gi)[1L]) checkEquals("e1_e2", names(numEdges(gi))) w <- c(as.numeric(NA), as.numeric(NA)) names(w) <- c("a=>b", "a=>c") checkEquals(list(e1_e2=w), eweights(gi, "=>")) } test_edgeSetIntersect0_random <- function() { make_data <- function(nsets, nn, ne, ns, type=c("directed", "undirected")) { ## nsets: number of edge sets ## nn: number of nodes ## ne: number of edges ## ns: number of shared edges directed <- switch(match.arg(type), directed=TRUE, undirected=FALSE, mixed=sample(c(TRUE, FALSE), nsets, replace=TRUE)) grouped <- randFromTo2(nn, (ne * nsets) + ns, directed = all(directed))$ft ## for the undirected case, we will end up with fewer edges so ## need to adjust. ne <- (nrow(grouped) - ns) %/% nsets shared <- grouped[1:ns, ] starts <- seq(ns, nrow(grouped) - ne, by = ne) + 1L esets <- vector("list", nsets) names(esets) <- paste("e", 1:nsets, sep = "") for (i in seq_along(esets)) { z <- grouped[seq(starts[[i]], starts[[i]] + ne - 1L), ] z <- rbind(shared, z) esets[[i]] <- z } list(shared=shared, g=MultiGraph(esets, directed = directed), esets = esets) } do_test <- function(d) { gi <- edgeSetIntersect0(d$g) checkEquals(nrow(d$shared), numEdges(gi)[[1]]) all_directed <- all(isDirected(d$g)) checkEquals(all_directed, isDirected(gi)[[1]]) checkEquals(nodes(d$g), nodes(gi)) } for (t in c("directed", "undirected")) { for (i in 1:10) { do_test(make_data(2, 10, 10, 3, type = t)) do_test(make_data(3, 10, 10, 3, type = t)) do_test(make_data(3, 10, 10, 1, type = t)) do_test(make_data(3, 11, 20, 6, type = t)) } } } test_subSetEdgeSets_single <- function(){ g <- make_directed_MultiGraph()$g gi <- subsetEdgeSets(g, "e1") checkEquals(nodes(g), nodes(gi)) checkEquals(c(e1 = 5L), numEdges(gi)[1L]) checkEquals("e1", names(numEdges(gi))) w <- c(1.0, 1.0, 3.1, 5.4, 2.2) names(w) <- c("b=>a", "a=>b", "a=>c", "a=>d", "b=>d") checkEquals(list(e1=w), eweights(gi, "=>")) } test_subSetEdgeSets_multiple <- function() { g <- make_mixed_MultiGraph()$g gi <- subsetEdgeSets(g, c("e1","e3")) checkEquals(nodes(g), nodes(gi)) checkEquals(c(e1 = 5L, e3 = 5L), numEdges(gi)) checkEquals(c("e1", "e3"), names(numEdges(gi))) w1 <- c( 1.0, 1.0, 3.1, 5.4, 2.2) w2 <- c(1, 2, 3, 5, 4) names(w1) <- c("b=>a", "a=>b", "a=>c", "a=>d", "b=>d") names(w2) <- c("a=>b", "a=>c", "a=>x", "c=>x", "x=>y") checkEquals(list(e1 = w1, e3 = w2), eweights(gi, "=>")) } test_subSetEdgeSets_no_duplicate_edgeSets <- function() { g <- make_directed_MultiGraph()$g checkException(subsetEdgeSets(g, c("e1", "e1"))) } test_subSetEdgeSets_no_such_edgeSet <- function() { g <- make_directed_MultiGraph()$g checkException(subsetEdgeSets(g, "notAnEdgeSet")) } test_subSetEdgeSets_empty_edgeSet <- function() { g <- make_directed_MultiGraph()$g gi <- subsetEdgeSets(g, character(0)) checkEquals(nodes(g), nodes(gi)) checkEquals("list", class(numEdges(gi))) checkEquals(0, length(numEdges(gi))) checkEquals(character(0), names(numEdges(gi))) } test_extractFromTo_Directed <- function(use.factors=TRUE){ ft1 <- data.frame(from=c("a", "a", "a", "b", "b"), to=c("b", "c", "d", "a", "d"), weight=c(1, 3.1, 5.4, 1, 2.2), stringsAsFactors = use.factors) ft2 <- data.frame(from=c("a", "a", "a", "x", "x", "c"), to=c("b", "c", "x", "y", "c", "a"), weight=c(3.4, 2.6, 1, 1, 1, 7.9), stringsAsFactors = use.factors) esets <- list(e1=ft1, e2=ft2) g <- MultiGraph(esets) res <- extractFromTo(g) ft1 <- ft1[do.call(order ,ft1["to"]),] rownames(ft1) <- 1:5 ft2 <- ft2[do.call(order ,ft2["to"]),] rownames(ft2) <- 1:6 checkEquals(list(e1 = ft1, e2 = ft2), res) } test_extractFromTo_UnDirected <- function(use.factors=TRUE){ ft1 <- data.frame(from=c("a", "a", "a", "b", "b"), to=c("b", "c", "d", "c", "d"), weight=c(1, 3.1, 5.4, 1, 2.2), stringsAsFactors = use.factors) ft2 <- data.frame(from=c("a", "a", "a", "x", "x", "c"), to=c("b", "a", "x", "y", "c", "a"), weight=c(3.4, 2.6, 1, 1, 1, 7.9), stringsAsFactors = use.factors) esets <- list(e1=ft1, e2=ft2) g <- MultiGraph(esets,directed=c(FALSE,FALSE)) res <- extractFromTo(g) ft1 <- ft1[do.call(order ,ft1["to"]),] rownames(ft1) <- 1:5 ft2["from"] <- factor(c("a", "a", "a", "a", "c", "x")) ft2["to"] <- factor(c("a", "b", "c", "x", "x", "y")) ft2["weight"] <- c(2.6, 3.4, 7.9, 1, 1, 1) checkEquals(list(e1 = ft1, e2 = ft2), res) } test_degree_Mixed <- function(use.factors=TRUE){ ft1 <- data.frame(from=c("a", "a", "a", "b", "b"), to=c("b", "c", "d", "c", "d"), weight=c(1, 3.1, 5.4, 1, 2.2), stringsAsFactors = use.factors) ft2 <- data.frame(from=c("a", "a", "a", "x", "x", "c"), to=c("b", "a", "x", "y", "c", "a"), weight=c(3.4, 2.6, 1, 1, 1, 7.9), stringsAsFactors = use.factors) esets <- list(e1=ft1, e2=ft2) g <- MultiGraph(esets,directed=c(FALSE,TRUE)) deg <- degree(g) e1Degree <- as.numeric(c(3, 3, 2, 2, 0, 0)) attributes(e1Degree) <- list(names=c("a","b","c","d","x","y")) inDegree <- as.numeric(c(2, 1, 1, 0, 1, 1)) attributes(inDegree) <- list(names=c("a","b","c","d","x","y")) outDegree <- as.numeric(c(3, 0, 1, 0, 2, 0)) attributes(outDegree) <- list(names=c("a","b","c","d","x","y")) res <- list(e1 = e1Degree, e2 = list(inDegree = inDegree, outDegree=outDegree)) checkEquals(res, deg) } checkSubGraph <- function(g, subG) { nds <- nodes(g) subNodes <- nodes(subG) origFromTo <- extractFromTo(g) subFromTo <- extractFromTo(subG) sapply(names(origFromTo), function(x){ indx <- (origFromTo[[x]]$from %in% subNodes) & (origFromTo[[x]]$to %in% subNodes) origdf = origFromTo[[x]] want <- origdf[(origdf$from %in% subNodes) & (origdf$to %in% subNodes),] subdf <- subFromTo[[x]] checkEquals(as.character(want$from), as.character(subdf$from)) checkEquals(as.character(want$to), as.character(subdf$to)) checkEquals(g@edge_sets[[x]]@weights[indx], subG@edge_sets[[x]]@weights) }) } test_basic_subGraph <- function() { g <- make_mixed_MultiGraph()$g nds <- nodes(g)[1:3] sg <- subGraph(nds, g) checkSubGraph(g,sg) } test_large_subGraph <- function() { df1 <- graph:::randFromTo(1000L, 10001L, directed = TRUE, weightFun = seq_len) df2 <- graph:::randFromTo(1000L, 10001L, directed = FALSE, weightFun = seq_len) g <- MultiGraph(list(e1= df1$ft, e2 = df2$ft)) nds <- sample( graph:::nodes(g), 100) subG <- subGraph(nds, g) checkSubGraph(g, subG) } test_basic_mgToGraphAM <- function() { g <- make_mixed_MultiGraph()$g res <- extractGraphAM(g) checkGraphAMObj(res, g) } test_large_mgToGraphAM <- function() { df1 <- graph:::randFromTo(800L, 90L, directed = TRUE, weightFun = seq_len) df2 <- graph:::randFromTo(800L, 60L, directed = FALSE, weightFun = seq_len) g <- MultiGraph(list(e1= df1$ft, e2 = df2$ft)) res <- extractGraphAM(g) checkGraphAMObj(res,g) } checkGraphAMObj <- function(am, mg){ nds <- nodes(mg) dr <- isDirected(mg) checkEquals(names(mg@edge_sets),names(am)) sapply(names(am), function(x){ mat <- as(am[[x]], "matrix") checkEquals(colnames(mat),rownames(mat)) checkEquals(colnames(mat), nds) wtMg <- graph:::edgeSetToMatrix(nds, mg@edge_sets[[x]], dr[[x]]) checkEquals(mat, wtMg) }) } test_mixed_MultiGraph_Intersect <- function(use.factors=TRUE) { ft1 <- data.frame(from=c("a", "a", "a", "b", "b"), to=c("b", "c", "d", "a", "d"), weight=c(1, 3.1, 5.4, 1, 2.2), stringsAsFactors = use.factors) ft2 <- data.frame(from=c("a", "a", "a", "x", "x"), to=c("b", "c", "x", "y", "c"), weight=c(3.4, 2.6, 1, 1, 1), stringsAsFactors = use.factors) ft3 <- data.frame(from=c("a", "a", "x", "x", "x"), to =c("b", "c", "a", "y", "c"), weight=c(1:5), stringsAsFactors = use.factors) esets <- list(e1=ft1, e2=ft2, e3=ft3, e4=ft2[FALSE, ], e5=ft3[FALSE, ]) g1 <- MultiGraph(esets, directed = c(TRUE, FALSE, TRUE, TRUE, FALSE)) ft1 <- data.frame(from=c("a", "b"), to=c("d", "d"), weight=c(5.4, 2.2), stringsAsFactors = use.factors) ft2 <- data.frame(from=c("a", "a", "a"), to=c("b", "c", "x"), weight=c(3.4, 2.6, 1), stringsAsFactors = use.factors) esets <- list(e1=ft1, e2=ft2) g2 <- MultiGraph(esets, directed = c(TRUE, FALSE)) res <- graphIntersect(g1, g2) checkEquals(nodes(res), c("a", "b", "c", "d", "x")) checkEquals(isDirected(res), structure(c(TRUE, FALSE), names = c("e1", "e2"))) df <- extractFromTo(res) checkEquals(names(df), c("e1", "e2")) df1 <- data.frame(from = c("a", "b"), to = c("d", "d"), weight = c(5.4, 2.2), stringsAsFactors = TRUE) checkEquals(df$e1, df1) df2 <- data.frame(from = c("a", "a", "a"), to = c("b", "c", "x"), weight = c(3.4, 2.6, 1), stringsAsFactors = TRUE) checkEquals(df$e2, df2) } test_mixed_MultiGraph_Union <- function(use.factors=TRUE) { ft1 <- data.frame(from=c("a", "a", "a", "b", "b"), to =c("b", "c", "d", "a", "d"), weight=c(1, 3.1, 5.4, 1, 2.2), stringsAsFactors = use.factors) ft2 <- data.frame(from=c("a", "a"), to=c("b", "c"), weight=c(3.4, 2.6), stringsAsFactors = use.factors) ft3 <- data.frame(from=c("a", "a"), to =c("d", "b"), weight=c(1,2), stringsAsFactors = use.factors) esets <- list(e1=ft1, e2=ft2, e3=ft3, e4=ft2[FALSE, ], e5=ft3[FALSE, ]) g1 <- MultiGraph(esets, directed = c(TRUE, FALSE, TRUE, TRUE, FALSE)) ft1 <- data.frame(from=c("a", "a", "b"), to=c("b", "x", "z"), weight=c(6, 5, 2), stringsAsFactors = use.factors) ft2 <- data.frame(from=c("a", "a", "a"), to=c("a", "x", "y"), weight=c(1, 2, 3), stringsAsFactors = use.factors) esets <- list(e1=ft1, e2=ft2) g2 <- MultiGraph(esets, directed = c(TRUE, FALSE)) res <- graphUnion(g1, g2) checkEquals(nodes(res), c("a", "b", "c", "d", "x", "y", "z")) checkEquals(names(res@edge_sets), c("e1", "e2", "e3", "e4", "e5")) checkEquals(isDirected(res), structure(c(TRUE, FALSE, TRUE, TRUE, FALSE), names = c("e1", "e2", "e3", "e4", "e5"))) df <- extractFromTo(res) checkEquals(names(df), c("e1", "e2", "e3", "e4", "e5")) df1 <- data.frame(from = c("b", "a", "a", "a", "b", "a", "b"), to = c("a", "b", "c", "d", "d", "x", "z"), weight = c(1, NA, 3.1, 5.4, 2.2, 5.0, 2.0), stringsAsFactors = TRUE) checkEquals(df$e1, df1) df2 <- data.frame(from = c("a", "a", "a", "a", "a"), to = c("a", "b", "c", "x", "y"), weight = c(1, 3.4, 2.6, 2, 3 ), stringsAsFactors = TRUE) checkEquals(df$e2, df2) df3 <- data.frame(from = c("a", "a"), to = c("b", "d"), weight = c(2, 1), stringsAsFactors = TRUE) checkEquals(df$e3, df3) df4 <- data.frame(from = factor(), to = factor(), weight = numeric(), stringsAsFactors = TRUE) checkEquals(df$e4, df4) checkEquals(df$e5, df4) } # test_MultiGraph_To_graphBAM <- function(use.factors=TRUE) { ft1 <- data.frame(from=c("a", "a", "a", "b", "b"), to=c("b", "c", "d", "a", "d"), weight=c(1, 3.1, 5.4, 1, 2.2), stringsAsFactors = use.factors) ft2 <- data.frame(from=c("a", "a", "a", "x", "x"), to=c("b", "c", "x", "y", "c"), weight=c(3.4, 2.6, 1, 1, 1), stringsAsFactors = use.factors) esets <- list(e1 = ft1, e2 = ft2, e3 = ft2[FALSE, ]) g1 <- MultiGraph(esets, directed = c(TRUE, FALSE, TRUE)) res <- extractGraphBAM(g1) checkEquals(names(res), c("e1", "e2", "e3")) bam1 <- graphBAM(ft1, nodes=nodes(g1), edgemode = "directed") checkEquals(bam1, res$e1) bam2 <- graphBAM(ft2, nodes=nodes(g1), edgemode = "undirected") checkEquals(bam2, res$e2) bam3 <- graphBAM( ft2[FALSE, ], nodes=nodes(g1), edgemode = "directed") checkEquals(bam3, res$e3) res <- extractGraphBAM(g1, "e1") checkEquals(bam1, res$e1) res <- extractGraphBAM(g1, c("e2", "e3")) target <- structure(list(bam2, bam3), names = c("e2", "e3")) checkEquals(target, res) } test_MultiGraph_nodeAttributes <- function() { mg <- make_directed_MultiGraph()$g nds <- nodes(mg) checkException(nodeData(mg, n = c("a"), attr = "color")) checkException( nodeData(mg, n = "z", attr = "color") <- "red") nodeDataDefaults(mg, attr = "color") <- "violet" nodeDataDefaults(mg, attr = "class") <- "unknown" nodeData(mg, n = c("a", "x") , attr = "color") <- c("red", "green") nodeData(mg, attr = "class") <- "high" current <- nodeData(mg, attr = "color") target <- structure(list("red", "violet", "violet", "violet", "green", "violet") , names = nds) checkEquals(target, current) current <- nodeData(mg, attr = "class") target <- structure( as.list(rep("high",6)), names = nds) checkEquals(target, current) sg <- subGraph(c("a", "x"), mg) current <- nodeData(sg, attr = "color") target <- structure( list("red","green"), names = c("a", "x")) checkEquals(target, current) nodeDataDefaults(mg, attr="st") <- "unknown" nodeData(mg, n = c("b", "d"), attr = "st") <- mg@edge_sets$e1 current <- nodeData(mg, attr = "st") target <- structure(list("unknown", mg@edge_sets$e1, "unknown", mg@edge_sets$e1, "unknown", "unknown"), names = c( "a", "b", "c", "d", "x", "y")) checkEquals(target, current) } test_MultiGraph_edgeAttributes_directed <- function() { ## Check directed edge mg <- make_mixed_MultiGraph()$g mgEdgeDataDefaults(mg, "e1", attr = "color") <- "violet" mgEdgeData(mg, "e1", from = c("a"), to = c("b"), attr = "color") <- "red" current <- mgEdgeData(mg, "e1", attr = "color") nms <- paste( c("b", "a", "a", "a", "b"), c("a","b", "c", "d", "d"),sep ="|") target <- structure( list( "violet", "red", "violet", "violet", "violet"), names = nms) checkEquals(target, current) mgEdgeData(mg, "e1", to = "d", attr = "color") <- "green" current <- mgEdgeData(mg, "e1", attr = "color") target <- structure( list("violet", "red", "violet", "green", "green"), names = nms) checkEquals(target, current) mgEdgeData(mg, "e1", from = "b", attr = "color") <- c("pink") current <- mgEdgeData(mg, "e1", attr = "color") target <- structure( list("pink", "red", "violet", "green" ,"pink"), names = nms) checkEquals(target, current) checkException(mgEdgeData(mg, "e1", attr = "class")) checkException(mgEdgeData(mg, "e9", attr = "color")) } test_MultiGraph_edgeAttributes_directed_S4 <- function() { ## Check directed edge mg <- make_mixed_MultiGraph()$g df <- extractFromTo(mg)$e1 mgEdgeDataDefaults(mg, "e1", attr = "color") <- "unknown" mgEdgeData(mg, "e1", from = c("a"), to = c("b"), attr = "color") <- df current <- mgEdgeData(mg, "e1", attr = "color") nms <- paste( c("b", "a", "a", "a", "b"), c("a","b", "c", "d", "d"),sep ="|") target <- structure( list( "unknown", df, "unknown", "unknown", "unknown"), names = nms) checkEquals(target, current) mgEdgeData(mg, "e1", to = "d", attr = "color") <- matrix(1) current <- mgEdgeData(mg, "e1", attr = "color") target <- structure( list("unknown", df, "unknown", matrix(1), matrix(1)), names = nms) checkEquals(target, current) mgEdgeData(mg, "e1", from = "b", attr = "color") <- matrix(0) current <- mgEdgeData(mg, "e1", attr = "color") target <- structure( list(matrix(0), df, "unknown", matrix(1), matrix(0)), names = nms) checkEquals(target, current) checkException(mgEdgeData(mg, "e1", attr = "class")) checkException(mgEdgeData(mg, "e9", attr = "color")) } test_MultiGraph_edgeAttributes_undirected <- function() { ## Check undirected edge mg <- make_mixed_MultiGraph()$g mgEdgeDataDefaults(mg, "e3", attr = "color") <- "unknown" mgEdgeData(mg, "e3", from = c("a"), to = c("b"), attr = "color") <- "red" current <- mgEdgeData(mg, "e3", to = "a", attr = "color") nms <- paste( c("b", "c", "x"), rep("a", 3), sep = "|") target <- structure(list("red", "unknown", "unknown"), names = nms) checkEquals(target, current) mgEdgeData(mg, "e3", to = "c", attr = "color") <- "green" current <- mgEdgeData(mg, "e3", to = "c", attr = "color") nms <- paste(c("a", "x"), c("c", "c"), sep = "|") target <- structure( list("green", "green"), names = nms) checkEquals(target, current) mgEdgeData(mg, "e3", from = "b", attr = "color") <- c("pink") current <- mgEdgeData(mg, "e3", attr = "color") nms <- paste(c("a", "a", "a", "c", "x", "b", "c", "x", "x", "y"), c("b", "c", "x", "x", "y", "a", "a", "a", "c", "x"), sep ="|") target <- structure( list("pink", "green", "unknown", "green", "unknown", "pink", "green", "unknown", "green", "unknown"), names = nms) checkEquals(target, current) } test_MultiGraph_edgeAttributes_undirected_S4 <- function() { ## Check undirected edge mg <- make_mixed_MultiGraph()$g mgEdgeDataDefaults(mg, "e3", attr = "color") <- "unknown" mgEdgeData(mg, "e3", from = c("a"), to = c("b"), attr = "color") <- matrix(1) current <- mgEdgeData(mg, "e3", to = "a", attr = "color") nms <- paste( c("b", "c", "x"), rep("a", 3), sep = "|") target <- structure(list(matrix(1), "unknown", "unknown"), names = nms) checkEquals(target, current) df <- data.frame(1:2) mgEdgeData(mg, "e3", to = "c", attr = "color") <- df current <- mgEdgeData(mg, "e3", to = "c", attr = "color") nms <- paste(c("a", "x"), c("c", "c"), sep = "|") target <- structure( list(df, df), names = nms) checkEquals(target, current) mgEdgeData(mg, "e3", from = "b", attr = "color") <- matrix(0) current <- mgEdgeData(mg, "e3", attr = "color") nms <- paste(c("a", "a", "a", "c", "x", "b", "c", "x", "x", "y"), c("b", "c", "x", "x", "y", "a", "a", "a", "c", "x"), sep ="|") target <- structure( list(matrix(0), df, "unknown", df, "unknown", matrix(0), df, "unknown", df, "unknown"), names = nms) checkEquals(target, current) } test_MultiGraph_edgeAttributes_empty <- function() { mg <- make_mixed_MultiGraph()$g checkException(mgEdgeData(mg, "e4", from ="a", attr = "color") <- "green") checkException(mgEdgeData(mg, "e4", attr = "color")) } test_MultiGraph_edgeAttributes_subGraph <- function() { mg <- make_mixed_MultiGraph()$g mgEdgeDataDefaults(mg, "e1", attr = "color") <- "violet" mgEdgeData(mg, "e1", attr = "color") <- "red" mgEdgeData(mg, "e1", from = c("a", "a"), to = c("b", "c"), attr = "color") <- c("yellow", "pink") current <- mgEdgeData(mg,"e1", attr ="color") nms <- paste(c("b", "a", "a", "a", "b"), c("a", "b", "c", "d", "d"), sep = "|") target <- structure(list("red", "yellow", "pink", "red", "red"), names = nms) checkEquals(target, current) sg <- subGraph(c("a","c", "d"), mg) current <- mgEdgeData(sg, "e1", attr = "color") nms <- paste(c("a", "a"), c("c", "d"), sep ="|") target <- structure( list("pink", "red"), names = nms) checkEquals(target, current) } test_MultiGraph_Intersection_Attributes <- function(use.factors=TRUE){ setClass("myType", representation = representation(typ ="character")) myType <- function(typ){ new("myType", typ = typ)} colorFun <- function(x,y) { if(x@typ =="low" || y@typ == "med") return("low") else return("high") } typeFun <- function(x,y) { if(is(x, "myType") && is(y, "myType")){ if(x@typ =="low" || y@typ == "med") return("low") else return("high") } else {return (NA)} } edgeFun <- structure(rep(list(structure( list(colorFun), names = "myType")),2), names = c("e1", "e2")) ft1 <- data.frame(from=c("a", "b", "b", "f"), to=c("b", "c", "d", "g"), weight=c(1, 2, 3, 4), stringsAsFactors = use.factors) ft2 <- data.frame(from =c("e", "f", "a", "b", "f"), to =c( "a", "a", "b", "c", "c"), weight =c(2, 3, 4, 5, 9), stringsAsFactors= use.factors) esets <- list(e1=ft1, e2=ft2) g1 <- MultiGraph(esets) mgEdgeDataDefaults(g1, "e1", attr = "color") <- "violet" mgEdgeData(g1, "e1", from = c("b", "b", "f"), to = c("c", "d", "g"), attr = "color") <- c ("red", "green", "green") mgEdgeDataDefaults(g1, "e2", attr = "color") <- "violet" mgEdgeData(g1, "e2", from = c("b", "f"), to = c("c", "c"), attr = "color") <- c("red", "green") mgEdgeDataDefaults(g1, "e1", attr = "myType") <- "missing" mgEdgeData(g1, "e1", from = c("b", "f"), to = c("c", "g"), attr = "myType") <- c(myType("low"), myType("high")) mgEdgeDataDefaults(g1, "e2", attr = "myType") <- "missing" mgEdgeData(g1, "e2", from = c("a", "f"), to = c("b", "c"), attr = "myType") <- c(myType("high"), myType("low")) ft1 <- data.frame(from=c("b", "f"), to=c("c", "g"), weight=c(2, 3), stringsAsFactors = use.factors) ft2 <- data.frame(from =c("a", "f"), to =c( "b", "c"), weight =c(4, 6), stringsAsFactors= use.factors) esets <- list(e1=ft1, e2=ft2) g2 <- MultiGraph(esets) mgEdgeDataDefaults(g2, "e1", attr = "color") <- "violet" mgEdgeData(g2, "e1", from = c("b", "f"), to = c("c", "g"), attr = "color") <- c ("red", "green") mgEdgeDataDefaults(g2, "e2", attr = "color") <- "violet" mgEdgeData(g2, "e2", from = c("a", "f"), to = c("b", "c"), attr = "color") <- c("red", "green") mgEdgeDataDefaults(g2, "e1", attr="myType") <- "unknown" mgEdgeData(g2, "e1", from = c("b", "f"), to = c("c", "g"), attr = "myType") <- c(myType("med"), myType("high")) mgEdgeDataDefaults(g2, "e2", attr="myType") <- "unknown" mgEdgeData(g2, "e2", from = c("a", "f"), to = c("b", "c"), attr = "myType") <- c(myType("high"), myType("med")) nodeDataDefaults(g1, attr = "color") <- "violet" nodeDataDefaults(g2, attr = "color") <- "violet" nodeDataDefaults(g1, attr= "type") <- "unknown" nodeDataDefaults(g2, attr = "type") <- "unknown" nodeData(g1,n = c("a", "b", "c"), attr ="color") <- c("red", "green", "blue") nodeData(g1,n = c("b", "c"), attr ="type") <- c(myType("low"), myType("high")) nodeData(g2,n = c("a", "b", "c"), attr ="color") <- c("red", "green", "red") nodeData(g2,n = c("b", "c"), attr ="type") <- c(myType("med"), myType("low")) res <- graphIntersect(g1, g2, nodeFun = list(type =typeFun), edgeFun = edgeFun) current <- mgEdgeData(res,"e1", attr = "weight") target <- structure(list(2, as.numeric(NA)), names = paste(c("b", "f"), c("c", "g"), sep="|")) checkEquals(target, current) current <- mgEdgeData(res,"e1", attr = "color") target <- structure(list("red", "green"), names = paste(c("b", "f"), c("c", "g"), sep="|")) checkEquals(target, current) current <- mgEdgeData(res,"e2", attr = "weight") target <- structure(list(4, as.numeric(NA)), names = paste(c("a", "f"), c("b", "c"), sep="|")) checkEquals(target, current) current <- mgEdgeData(res,"e2", attr = "color") target <- structure(list(as.character(NA), "green"), names = paste(c("a", "f"), c("b", "c"), sep="|")) checkEquals(target, current) current <- mgEdgeData(res,"e1", attr = "myType") target <- structure(list("low", "high"), names = paste(c("b", "f"), c("c", "g"), sep="|")) checkEquals(target, current) current <- mgEdgeData(res,"e2", attr = "myType") target <- structure(list("high", "low"), names = paste(c("a", "f"), c("b", "c"), sep="|")) checkEquals(target, current) nodeColor <- nodeData(res, attr = "color") target <- as.list(structure(c("red", "green", NA, "violet", "violet"), names = c("a", "b", "c", "f", "g"))) checkEquals(target, nodeColor) nodeType <- nodeData(res, attr = "type") target <- as.list(structure(c("unknown", "low", "high", "unknown", "unknown"), names = c("a", "b", "c", "f", "g"))) checkEquals(target, nodeType) } test_MultiGraph_Union_Attributes <- function(use.factors=TRUE){ setClass("myType", representation = representation(typ ="character")) myType <- function(typ){ new("myType", typ = typ)} typeFun <- function(x,y) { if(is(x, "myType") && is(y, "myType")){ if(x@typ =="low" || y@typ == "med") return("low") else return("high") } else {return (NA)} } funList <- structure(rep(list(structure( list(typeFun), names = "myType")),2), names = c("e1", "e2")) ft1 <- data.frame(from=c("a", "b", "b", "f"), to=c("b", "c", "d", "g"), weight=c(1, 2, 3, 4), stringsAsFactors = use.factors) ft2 <- data.frame(from =c("e", "f", "a", "b", "f"), to =c( "a", "a", "b", "c", "c"), weight =c(2, 3, 4, 5, 9), stringsAsFactors= use.factors) esets <- list(e1=ft1, e2=ft2) g1 <- MultiGraph(esets) mgEdgeDataDefaults(g1, "e1", attr = "color") <- "violet" mgEdgeData(g1, "e1", from = c("b", "b", "f"), to = c("c", "d", "g"), attr = "color") <- c ("red", "green", "green") mgEdgeDataDefaults(g1, "e2", attr = "color") <- "violet" mgEdgeData(g1, "e2", from = c("b", "f"), to = c("c", "c"), attr = "color") <- c("red", "green") mgEdgeDataDefaults(g1, "e1", attr ="myType") <- "unknown" mgEdgeData(g1, "e1", from = c("b", "f"), to = c("c", "g"), attr = "myType") <- c(myType("low"), myType("high")) mgEdgeDataDefaults(g1, "e2", attr ="myType") <- "unknown" mgEdgeData(g1, "e2", from = c("a", "f"), to = c("b", "c"), attr = "myType") <- c(myType("high"), myType("low")) ft1 <- data.frame(from=c("b", "f"), to=c("c", "g"), weight=c(2, 3), stringsAsFactors = use.factors) ft2 <- data.frame(from =c("a", "f"), to =c( "b", "c"), weight =c(4, 6), stringsAsFactors= use.factors) esets <- list(e1=ft1, e2=ft2) g2 <- MultiGraph(esets) mgEdgeDataDefaults(g2, "e1", attr = "color") <- "violet" mgEdgeData(g2, "e1", from = c("b", "f"), to = c("c", "g"), attr = "color") <- c ("red", "green") mgEdgeDataDefaults(g2, "e2", attr = "color") <- "violet" mgEdgeData(g2, "e2", from = c("a", "f"), to = c("b", "c"), attr = "color") <- c("red", "green") mgEdgeDataDefaults(g2, "e1", attr = "myType") <- "unknown" mgEdgeData(g2, "e1", from = c("b", "f"), to = c("c", "g"), attr = "myType") <- c(myType("med"), myType("high")) mgEdgeDataDefaults(g2, "e2", attr = "myType") <- "unknown" mgEdgeData(g2, "e2", from = c("a", "f"), to = c("b", "c"), attr = "myType") <- c(myType("high"), myType("med")) res <- graphUnion(g1, g2, edgeFun = funList) current <- mgEdgeData(res,"e1", attr = "weight") target <- structure(list(1, 2, 3, as.numeric(NA)), names = paste(c("a", "b", "b", "f"), c( "b", "c", "d", "g"), sep="|")) checkEquals(target, current) current <- mgEdgeData(res,"e1", attr = "color") target <- structure(list("violet", "red", "green", "green"), names = paste(c("a", "b", "b", "f"), c("b", "c", "d", "g"), sep="|")) checkEquals(target, current) current <- mgEdgeData(res,"e2", attr = "weight") target <- structure(list(2, 3, 4, 5, as.numeric(NA)), names = paste(c("e", "f", "a", "b", "f"), c("a", "a", "b", "c", "c"), sep="|")) checkEquals(target, current) current <- mgEdgeData(res,"e2", attr = "color") target <- structure(list( "violet", "violet", as.character(NA), "red", "green"), names = paste(c("e", "f", "a", "b", "f"), c("a", "a", "b", "c", "c"), sep="|")) checkEquals(target, current) current <- mgEdgeData(res,"e1", attr = "myType") target <- structure(list("unknown", "low", "unknown", "high"), names = paste(c("a", "b", "b", "f"), c("b", "c", "d", "g"), sep="|")) checkEquals(target, current) current <- mgEdgeData(res,"e2", attr = "myType") target <- structure(list("unknown", "unknown", "high", "unknown","low"), names = paste(c("e", "f", "a", "b", "f"), c("a", "a", "b", "c", "c"), sep="|")) checkEquals(target, current) } test_MultiGraph_nodeUnion_Attributes <- function(use.factors=TRUE){ setClass("myType", representation = representation(typ ="character")) myType <- function(typ){ new("myType", typ = typ)} testFun <- function(x,y) { if(is(x, "myType") && is(y, "myType")){ if(x@typ =="aa" || y@typ == "ac") return("ax") else return("notype") } else return("ab") } funList <- structure(list(testFun), names ="gene") ft1 <- data.frame(from=c("a", "a", "a", "b", "b"), to =c("b", "c", "d", "a", "d"), weight=c(1, 3.1, 5.4, 1, 2.2), stringsAsFactors = use.factors) ft2 <- data.frame(from=c("a", "a"), to=c("b", "c"), weight=c(3.4, 2.6), stringsAsFactors = use.factors) ft3 <- data.frame(from=c("a", "a"), to =c("d", "b"), weight=c(1,2), stringsAsFactors = use.factors) esets <- list(e1=ft1, e2=ft2, e3=ft3, e4=ft2[FALSE, ], e5=ft3[FALSE, ]) g1 <- MultiGraph(esets, directed = c(TRUE, FALSE, TRUE, TRUE, FALSE)) nodeDataDefaults(g1, attr = "color") <- "violet" nodeData(g1, n = c("a", "b", "c") , attr = "color") <- c("red", "green", "blue") nodeDataDefaults(g1, attr = "type") <- "unknown" nodeData(g1, n = c("a", "b"), attr = "type") <- c("low", "high") nodeDataDefaults(g1, attr = "kp") <- "kpunknown" nodeData(g1, n = c("a", "b"), attr = "kp") <- c("kplow", "kphigh") nodeDataDefaults(g1, attr = "gene") <- "XX" nodeData(g1, n = c("a", "b"), attr = "gene") <- c(myType("aa"), myType("bt")) ft1 <- data.frame(from=c("a", "a", "b"), to=c("b", "x", "z"), weight=c(6, 5, 2), stringsAsFactors = use.factors) ft2 <- data.frame(from=c("a", "a", "a"), to=c("a", "x", "y"), weight=c(1, 2, 3), stringsAsFactors = use.factors) esets <- list(e1=ft1, e2=ft2) g2 <- MultiGraph(esets, directed = c(TRUE, FALSE)) nodeDataDefaults(g2, attr ="color") <- "violet" nodeData(g2, n = c("a", "b", "x", "y", "z") , attr = "color") <- c("red", "red", "green", "pink", "yellow") nodeDataDefaults(g2, attr ="type") <- "unknown" nodeData(g2, n = c("a", "b"), attr = "type") <- c("low", "high") nodeDataDefaults(g2, attr ="gene") <- "XX" nodeData(g2, n = c("a", "b"), attr = "gene") <- c(myType("at"), myType("kt")) res <- graphUnion(g1, g2, nodeFun = funList ) current <- nodeData(res, attr = "color") target <- as.list( structure(c("red", NA, "blue", "violet", "green", "pink", "yellow"), names = c("a", "b", "c", "d", "x", "y", "z"))) checkEquals(target, current) current <- nodeData(res, attr = "type") target <- as.list( structure(c("low", "high", "unknown", "unknown", "unknown", "unknown", "unknown"), names = c("a", "b", "c", "d", "x", "y", "z"))) checkEquals(target, current) current <- nodeData(res, attr = "kp") cn <- "kpunknown" target <- as.list( structure(c("kplow", "kphigh", cn, cn, cn, cn, cn), names = c("a", "b", "c", "d", "x", "y", "z"))) checkEquals(target, current) current <- nodeData(res, n =c("a", "b"), attr ="gene") target <- as.list( structure(c("ax", "notype"), names = c("a", "b"))) checkEquals(target, current) current <- nodeData(res, n = c("c", "d", "x", "y", "z"), attr ="gene") target <- as.list( structure(c( "XX", "XX", "XX", "XX", "XX"), names = c("c", "d", "x", "y", "z"))) checkEquals(target, current) } graph/inst/unitTests/edgeWeights_test.R0000644000175000017500000000340514136046755020122 0ustar nileshnileshegGraphAM <- function() { mat <- matrix(c(0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 1, 0), byrow=TRUE, ncol=4) rownames(mat) <- colnames(mat) <- letters[1:4] gam <- graphAM(adjMat=mat, edgemode="directed") } testDefaultIsOnes <- function() { gam <- egGraphAM() expect <- list(a=c(c=1, d=1), b=c(c=1), c=numeric(0), d=c(b=1, c=1)) checkEquals(expect, edgeWeights(gam)) checkEquals(expect[c("a", "d")], edgeWeights(gam, c("a", "d"))) checkEquals(expect[c("a", "d")], edgeWeights(gam, c(1, 4))) ## Also test alternate attr name when undefined checkEquals(expect, edgeWeights(gam, attr="foobar")) } testSettingDefaultValue <- function() { gam <- egGraphAM() expect <- list(a=c(c=4, d=4), b=c(c=4), c=numeric(0), d=c(b=4, c=4)) checkEquals(expect, edgeWeights(gam, default=4)) checkEquals(expect[c("a", "d")], edgeWeights(gam, c("a", "d"), default=4)) checkEquals(expect[c("a", "d")], edgeWeights(gam, c(1, 4), default=4)) } testTypeChecker <- function() { gam <- egGraphAM() simple <- list(a=c(c=1, d=1), b=c(c=1), c=numeric(0), d=c(b=1, c=1)) expect <- list(a=c(c=5:5, d=6:6), b=c(c=4:4), c=numeric(0), d=c(b=4:4, c=4:4)) edgeDataDefaults(gam, attr="foo") <- 4:4 edgeData(gam, from="a", attr="foo") <- c(5:5, 6:6) checkException(edgeWeights(gam, attr="foo", type.checker=is.double), silent=TRUE) checkException(edgeWeights(gam, type.checker=is.integer)) checkEquals(expect, edgeWeights(gam, attr="foo")) checkEquals(expect, edgeWeights(gam, attr="foo", type.checker=is.integer)) checkEquals(simple, edgeWeights(gam)) } graph/inst/unitTests/clusterGraph_test.R0000644000175000017500000000057114136046755020327 0ustar nileshnileshbasicCluserGraph <- function() { new("clusterGraph", clusters=list( a=c(1,2,3), b=c(4,5,6))) } rename_nodes_test <- function() { g <- basicCluserGraph() checkEquals(as.character(1:6), nodes(g)) nodes(g) <- letters[1:6] checkEquals(letters[1:6], nodes(g)) checkEquals(letters[1:6], names(edges(g))) } graph/inst/unitTests/attrData_test.R0000644000175000017500000001145214136046755017430 0ustar nileshnileshbasicProps <- list(weight=1, color="blue", friends=c("bob", "alice")) testCreation <- function() { aset <- new("attrData", defaults=basicProps) checkEquals(TRUE, is(aset, "attrData")) } testDefaultAttributesGetting <- function() { aset <- new("attrData", defaults=basicProps) ## Get the entire list checkEquals(basicProps, attrDefaults(aset)) ## Get a single attribute checkEquals(basicProps$weight, attrDefaults(aset, attr="weight")) checkEquals(basicProps$friends, attrDefaults(aset, attr="friends")) ## It is an error to ask for an undefined attr checkException(attrDefaults(aset, attr="NOSUCHATTRIBUTE"), silent=TRUE) ## You can only ask for one attr at a time checkException(attrDefaults(aset, attr=c("weight", "friends")), silent=TRUE) } testDefaultAttributesSetting <- function() { aset <- new("attrData", defaults=basicProps) ## Edit default value, type changes are allowed attrDefaults(aset, attr="weight") <- 100 checkEquals(100, attrDefaults(aset, attr="weight")) ## Add a new attribute attrDefaults(aset, attr="size") <- c(1, 2) checkEquals(c(1, 2), attrDefaults(aset, attr="size")) ## This is sort of dangerous, but for now, we'll allow it. ## I would prefer the attributes to be write-once and there ## forever. Or at least a special interface to remove unwanted... newProps <- list(dir="home", size=100) attrDefaults(aset) <- newProps checkEquals(newProps, attrDefaults(aset)) } testItemGettingAndSettingSimple <- function() { aset <- new("attrData", defaults=basicProps) ## access to defaults checkEquals(1, attrDataItem(aset, x="k1", attr="weight")[[1]]) expect <- as.list(rep(1, 3)) names(expect) <- letters[1:3] checkEquals(expect, attrDataItem(aset, x=letters[1:3], attr="weight")) ## mixed custom/defaults attrDataItem(aset, x="k1", attr="weight") <- 900 checkEquals(900, attrDataItem(aset, x="k1", attr="weight")[[1]]) ## Retrieve entire attribute list expect <- basicProps expect[["weight"]] <- 900 checkEquals(expect, attrDataItem(aset, x=c("k1", "newone"))[[1]]) checkEquals(basicProps, attrDataItem(aset, x=c("k1", "newone"))[[2]]) ## error on unknown attrs checkException(attrDataItem(aset, "k1", "UNKNOWN"), silent=TRUE) checkException(attrDataItem(aset, "k1", "UNKNOWN") <- "BAD", silent=TRUE) } testItemGettingAndSettingVectorized <- function() { aset <- new("attrData", defaults=basicProps) keys <- c("k1", "k2", "k3") ## Set multiple with same value 1 attrDataItem(aset, x=keys, attr="weight") <- 222 expectPerElem <- basicProps expectPerElem[["weight"]] <- 222 for(k in keys) checkEquals(expectPerElem, attrDataItem(aset, k)[[1]]) ## Set multiple with same value 2 complexVal <- list(a=as.list(1:3), b="ccc", c=1:5) attrDataItem(aset, x=keys, attr="weight") <- list(complexVal) expectPerElem <- basicProps expectPerElem[["weight"]] <- complexVal checkEquals(expectPerElem, attrDataItem(aset, "k1")[[1]]) checkEquals(expectPerElem, attrDataItem(aset, "k2")[[1]]) checkEquals(expectPerElem, attrDataItem(aset, "k3")[[1]]) ## Set multiple with same value 3 complexVal <- list(a=as.list(1:3), b="ccc", c=1:5, d="extra") attrDataItem(aset, x=keys, attr="weight") <- list(complexVal) expectPerElem <- basicProps expectPerElem[["weight"]] <- complexVal for(k in keys) checkEquals(expectPerElem, attrDataItem(aset, k)[[1]]) ## Set multiple with distinct values 1 wVect <- c(10, 20, 30) attrDataItem(aset, x=keys, attr="weight") <- wVect for (i in 1:length(wVect)) checkEquals(wVect[i], attrDataItem(aset, keys[i], "weight")[[1]]) ## Set multiple with distinct values 2 wVect <- list(list(a=1), list(a=2), list(a=3)) attrDataItem(aset, x=keys, attr="weight") <- wVect for (i in 1:length(wVect)) checkEquals(wVect[[i]], attrDataItem(aset, keys[i], "weight")[[1]]) } testItemRemovalSimple <- function() { aset <- new("attrData", defaults=basicProps) attrDataItem(aset, x="k1", attr="weight") <- 900 checkEquals(900, attrDataItem(aset, x="k1", attr="weight")[[1]]) removeAttrDataItem(aset, x="k1") <- NULL checkEquals(1, attrDataItem(aset, x="k1", attr="weight")[[1]]) } testNames <- function() { aset <- new("attrData", defaults=basicProps) attrDataItem(aset, x=letters, attr="weight") <- 1:26 checkEquals(letters, names(aset)) names(aset) <- LETTERS checkEquals(LETTERS, names(aset)) ## must have right length checkException(names(aset) <- letters[1:4], silent=TRUE) ## can't have NA bad <- letters bad[11] <- NA checkException(names(aset) <- bad, silent=TRUE) ## can't have duplicates bad[11] <- "b" checkException(names(aset) <- bad, silent=TRUE) } graph/inst/unitTests/nodeAndEdgeData_test.R0000644000175000017500000002267214136046755020621 0ustar nileshnilesh# # Test setup # simpleInciMat <- function() { ## Here's a simple graph for testing ## a b ## |\ /| ## | \___c___/ | ## | | | ## \ | / ## \____d____/ ## ## mat <- matrix(c(0, 0, 1, 1, 0, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0), byrow=TRUE, ncol=4) rownames(mat) <- letters[1:4] colnames(mat) <- letters[1:4] mat } simpleDirectedGraph <- function() { ## Here's a simple graph for testing ## a b ## |\ /^ ## | \__>c<__/ | ## | ^ | ## \ | / ## \___>d____/ ## ## mat <- matrix(c(0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 1, 0), byrow=TRUE, ncol=4) rownames(mat) <- letters[1:4] colnames(mat) <- letters[1:4] mat graphAM(adjMat=mat, edgemode="directed") } testNodeDataDefaults <- function() { mat <- simpleInciMat() g1 <- graphAM(adjMat=mat) ## If no attributes have been defined, empty list. checkEquals(list(), nodeDataDefaults(g1)) ## Can assign a named list myEdgeAttributes <- list(foo=1, bar="blue") nodeDataDefaults(g1) <- myEdgeAttributes checkEquals(myEdgeAttributes, nodeDataDefaults(g1)) checkEquals(myEdgeAttributes$foo, nodeDataDefaults(g1, attr="foo")) nodeDataDefaults(g1, attr="size") <- 400 checkEquals(400, nodeDataDefaults(g1, attr="size")) checkException(nodeDataDefaults(g1, attr="NOSUCHATTRIBUTE"), silent=TRUE) checkException(nodeDataDefaults(g1) <- list(1, 3, 4), silent=TRUE) ## must have names } testEdgeDataDefaults <- function() { mat <- simpleInciMat() g1 <- graphAM(adjMat=mat) ## If no attributes have been defined, empty list. checkEquals(list(), edgeDataDefaults(g1)) ## Can assign a named list myEdgeAttributes <- list(foo=1, bar="blue") edgeDataDefaults(g1) <- myEdgeAttributes checkEquals(myEdgeAttributes, edgeDataDefaults(g1)) checkEquals(myEdgeAttributes$foo, edgeDataDefaults(g1, attr="foo")) edgeDataDefaults(g1, attr="size") <- 400 checkEquals(400, edgeDataDefaults(g1, attr="size")) checkException(edgeDataDefaults(g1, attr="NOSUCHATTRIBUTE"), silent=TRUE) checkException(edgeDataDefaults(g1) <- list(1, 3, 4), silent=TRUE) ## must have names } testNodeDataGetting <- function() { mat <- simpleInciMat() g1 <- graphAM(adjMat=mat) myAttributes <- list(size=1, dim=c(3, 3), name="fred") nodeDataDefaults(g1) <- myAttributes checkEquals("fred", nodeData(g1, "a", attr="name")[[1]]) someNodes <- c("a", "b") expect <- as.list(c(1, 1)) names(expect) <- someNodes checkEquals(expect, nodeData(g1, n=someNodes, attr="size")) expect <- as.list(rep("fred", length(nodes(g1)))) names(expect) <- nodes(g1) checkEquals(expect, nodeData(g1, attr="name")) checkEquals(myAttributes, nodeData(g1, n="a")[[1]]) everything <- nodeData(g1) for (alist in everything) checkEquals(myAttributes, alist) } testNodeDataSetting <- function() { mat <- simpleInciMat() g1 <- graphAM(adjMat=mat) myAttributes <- list(size=1, dim=c(3, 3), name="fred") nodeDataDefaults(g1) <- myAttributes ## unknown node is error checkException(nodeData(g1, n="UNKNOWN_NODE", attr="size") <- 5, silent=TRUE) ## unknown attr is error checkException(nodeData(g1, n="a", attr="UNKNOWN") <- 5, silent=TRUE) nodeData(g1, n="a", attr="size") <- 5 checkEquals(5, nodeData(g1, n="a", attr="size")[[1]]) nodeData(g1, n=c("a", "b", "c"), attr="size") <- 50 expect <- myAttributes expect[["size"]] <- 50 checkEquals(list(a=expect, b=expect, c=expect), nodeData(g1, n=c("a", "b", "c"))) nodeData(g1, n=c("a", "b", "c"), attr="size") <- c(1, 2, 3) checkEquals(c(1, 2, 3), as.numeric(nodeData(g1, n=c("a", "b", "c"), attr="size"))) nodeData(g1, attr="name") <- "unknown" expect <- as.list(rep("unknown", length(nodes(g1)))) names(expect) <- nodes(g1) checkEquals(expect, nodeData(g1, attr="name")) } testEdgeDataGetting <- function() { mat <- simpleInciMat() g1 <- graphAM(adjMat=mat) myAttributes <- list(size=1, dim=c(3, 3), name="fred") edgeDataDefaults(g1) <- myAttributes checkEquals("fred", edgeData(g1, from="a", to="d", attr="name")[[1]]) fr <- c("a", "b") to <- c("c", "c") expect <- as.list(c(1, 1)) names(expect) <- c("a|c", "b|c") checkEquals(expect, edgeData(g1, fr, to, attr="size")) expect <- rep("fred", sum(sapply(edges(g1), length))) checkEquals(expect, as.character(edgeData(g1, attr="name"))) checkEquals(myAttributes, edgeData(g1, from="a", to="c")[[1]]) everything <- edgeData(g1) for (alist in everything) checkEquals(myAttributes, alist) got <- edgeData(g1, from="d", attr="size") checkEquals(3, length(got)) checkEquals(rep(1, 3), as.numeric(got)) got <- edgeData(g1, to="d", attr="size") checkEquals(3, length(got)) checkEquals(rep(1, 3), as.numeric(got)) expect <- c("a|c", "a|d", "d|a", "d|b", "d|c") checkEquals(expect, names(edgeData(g1, from=c("a", "d"), attr="name"))) } testEdgeDataToOnlyUndir <- function() { mat <- simpleInciMat() mat[1, 3] <- mat[3, 1] <- 100 mat[1, 4] <- mat[4, 1] <- 200 g1 <- graphAM(adjMat=mat, values=list(weight=1)) got <- edgeData(g1, to=c("a", "b"), attr="weight") expect <- c("c|a", "d|a", "c|b", "d|b") checkEquals(expect, names(got)) } testEdgeDataToOnlyDir <- function() { g1 <- simpleDirectedGraph() edgeDataDefaults(g1, attr="weight") <- 1 edgeData(g1, from=c("a", "b"), to=c("c", "c"), attr="weight") <- c(10, 20) got <- edgeData(g1, to=c("a", "b"), attr="weight") expect <- c("d|b") checkEquals(expect, names(got)) } testEdgeDataSettingDirected <- function() { g1 <- simpleDirectedGraph() myAttributes <- list(size=1, dim=c(3, 3), name="fred") edgeDataDefaults(g1) <- myAttributes edgeData(g1, from="a", to="d", attr="name") <- "Joe" expect <- myAttributes expect[["name"]] <- "Joe" checkEquals(expect, edgeData(g1, from="a", to="d")[[1]]) fr <- c("a", "b") to <- c("c", "c") expect <- as.list(c(5, 5)) names(expect) <- c("a|c", "b|c") edgeData(g1, fr, to, attr="size") <- 5 checkEquals(expect, edgeData(g1, fr, to, attr="size")) expect <- as.list(c(10, 20)) names(expect) <- c("a|c", "b|c") edgeData(g1, fr, to, attr="size") <- c(10, 20) checkEquals(expect, edgeData(g1, fr, to, attr="size")) edgeData(g1, from="a", attr="size") <- 555 checkEquals(rep(555, 2), as.numeric(edgeData(g1, from="a", attr="size"))) edgeData(g1, to="b", attr="size") <- 111 checkEquals(111, as.numeric(edgeData(g1, to="b", attr="size"))) } testEdgeDataSettingUndirected <- function() { mat <- simpleInciMat() g1 <- graphAM(adjMat=mat) myAttributes <- list(size=1, dim=c(3, 3), name="fred") edgeDataDefaults(g1) <- myAttributes edgeData(g1, from="a", to="d", attr="name") <- "Joe" expect <- myAttributes expect[["name"]] <- "Joe" checkEquals(expect, edgeData(g1, from="a", to="d")[[1]]) ## verify reciprocal edge data was set checkEquals("Joe", edgeData(g1, from="d", to="a", attr="name")[[1]]) fr <- c("a", "b") to <- c("c", "c") expect <- as.list(c(5, 5)) names(expect) <- c("a|c", "b|c") edgeData(g1, fr, to, attr="size") <- 5 checkEquals(expect, edgeData(g1, fr, to, attr="size")) names(expect) <- c("c|a", "c|b") checkEquals(expect, edgeData(g1, to, fr, attr="size")) expect <- as.list(c(10, 20)) names(expect) <- c("a|c", "b|c") edgeData(g1, fr, to, attr="size") <- c(10, 20) checkEquals(expect, edgeData(g1, fr, to, attr="size")) names(expect) <- c("c|a", "c|b") checkEquals(expect, edgeData(g1, to, fr, attr="size")) edgeData(g1, from="a", attr="size") <- 555 checkEquals(rep(555, 2), as.numeric(edgeData(g1, from="a", attr="size"))) checkEquals(555, edgeData(g1, from="c", to="a", attr="size")[[1]]) edgeData(g1, to="b", attr="size") <- 111 checkEquals(rep(111, 2), as.numeric(edgeData(g1, to="b", attr="size"))) checkEquals(111, edgeData(g1, from="c", to="b", attr="size")[[1]]) } testEdgeDataSettingFromOnly <- function() { mat <- simpleInciMat() g1 <- graphAM(adjMat=mat) myAttributes <- list(size=1, dim=c(3, 3), name="fred") edgeDataDefaults(g1) <- myAttributes expect <- rep("fred", 5) got <- unlist(edgeData(g1, from=c("a", "d"), attr="name"), use.names=FALSE) checkEquals(expect, got, "precondition check") edgeData(g1, from=c("a", "d"), attr="name") <- "Sam" expect <- rep("Sam", 5) got <- unlist(edgeData(g1, from=c("a", "d"), attr="name"), use.names=FALSE) checkEquals(expect, got, "use from only in assign") } testNormalizeEdges <- function() { checkException(graph:::.normalizeEdges(c("b", "d"), c("a", "b", "c")), silent=TRUE) checkException(graph:::.normalizeEdges(c("a", "b", "c"), c("a", "e")), silent=TRUE) f <- letters[1:10] t <- letters[11:20] checkEquals(list(from=f, to=t), graph:::.normalizeEdges(f, t)) checkEquals(list(from=c("a", "a", "a"), to=c("a", "b", "c")), graph:::.normalizeEdges("a", c("a", "b", "c"))) checkEquals(list(from=c("a", "b", "c"), to=c("d", "d", "d")), graph:::.normalizeEdges(c("a", "b", "c"), "d")) } graph/inst/unitTests/graphBAM_test.R0000644000175000017500000017173114136046755017314 0ustar nileshnilesh## library("graph") set.seed(0x12a9b) library(graph) library(RUnit) randBAMGraph <- function(numNodes = 10 , numEdges = 10) { df <- graph:::randFromTo(numNodes, numEdges) df$ft$weight = seq_len(numNodes) g <- graphBAM(df$ft, nodes = df$nodes, edgemode = "directed") g } make_smallBAM <- function() { from = c("a", "a", "a", "x", "x", "c") to = c("b", "c", "x", "y", "c", "a") weight=c(3.4, 2.6, 1.7, 5.3, 1.6, 7.9) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g1 <- graphBAM(df, edgemode = "directed") g1 } make_unDirectedBAM <- function() { from = c("a", "a", "a", "x", "x", "c") to = c("b", "c", "x", "y", "c", "d") weight=c(3.4, 2.6, 1.7, 5.3, 1.6, 7.9) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g1 <- graphBAM(df, edgemode = "undirected") g1 } create_bigBAM <- function() { r1 <- randFromTo(100, 100) r1$ft$weight <- seq_len(100) g1 <- graphBAM(r1$ft, r1$nodes, edgemode="directed") g1 } test_create_graphBAMSmall <- function() { from = c("a", "d", "d", "b") to = c("b", "a", "d", "c") weight= c(1.5, 3.1, 5.4, 1) nodes = c("a","b","c","d") df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g1 <- graphBAM(df, nodes, edgemode = "directed") g2 <- graphBAM(df, nodes, edgemode = "undirected") checkEquals(4L, numEdges(g1)) checkEquals(isDirected(g1), TRUE) checkEquals(isAdjacent(g1, c("a", "d", "b"), c("b", "d", "c") ), c(TRUE,TRUE,TRUE)) checkEquals(names(edges(g1)), c("a", "b", "c", "d")) k <- edges(g1) checkEquals(list(k$a, k$b, k$c, k$d), list("b", "c", character(0), c("a", "d"))) w <- edgeWeights(g1) checkEquals(names(w), c("a", "b", "c", "d")) checkEquals(list(w$a, w$b, w$c, w$d), list(structure(1.5, names="b"), structure(1, names="c"), numeric(0), structure(c(3.1, 5.4), names= c("a", "d")))) checkEquals(4L, numNodes(g2)) checkEquals(4L, numEdges(g2)) checkEquals(isDirected(g2), FALSE) checkEquals(isAdjacent(g1, c("a","d","b"), c("b","d","c") ), c(TRUE,TRUE,TRUE)) } test_BAMNodes <- function() { from = c("a", "a", "a", "x", "x", "c") to = c("b", "c", "x", "y", "c", "a") weight=c(3.4, 2.6, 1.7, 5.3, 1.6, 7.9) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g1 <- graphBAM(df, edgemode = "directed") nds <- nodes(g1) checkIdentical(all(nds %in% unique(c(from,to))),TRUE) checkIdentical(isDirected(g1),TRUE) ## node names from = paste0("X", 8:11) to = paste0("X", 8:11) df <- data.frame(from, to, weight=rep(1, 4), stringsAsFactors = TRUE) g2 <- graphBAM(df) ## no 'nodes' checkIdentical(nodes(g2), c("X10", "X11", "X8", "X9")) g2 <- graphBAM(df, nodes="X7") ## degree-zero node checkIdentical(nodes(g2), c("X10", "X11", "X7", "X8", "X9")) g2 <- graphBAM(df, nodes=paste0("X", 8:11)) ## forced ordering checkIdentical(nodes(g2), c("X8", "X9", "X10", "X11")) } checkBAMSubGraph <- function(g, subG) { nds <- nodes(g) subNodes <- nodes(subG) w1 <- g@edgeSet@weights ft1 <- .Call(graph:::graph_bitarray_rowColPos, g@edgeSet@bit_vector) origFromTo <- data.frame(from=nds[ft1[,"from"]], to = nds[ft1[,"to"]], weights = w1, stringsAsFactors = TRUE) w2 <- subG@edgeSet@weights ft2 <- .Call(graph:::graph_bitarray_rowColPos, subG@edgeSet@bit_vector) subFromTo <- data.frame(from = subNodes[ft2[,"from"]], to = subNodes[ft2[,"to"]], weights = w2, stringsAsFactors = TRUE) indx <- (origFromTo$from %in% subNodes) & (origFromTo$to %in% subNodes) want <- origFromTo[(origFromTo$from %in% subNodes) & (origFromTo$to %in% subNodes),] checkEquals(as.character(want$from), as.character(subFromTo$from)) checkIdentical(as.character(want$to), as.character(subFromTo$to)) checkEquals(g@edgeSet@weights[indx], subG@edgeSet@weights) } test_BAMSubGraph_Small <- function() { g1 <- make_smallBAM() sg <- subGraph(c("a","x", "y"), g1) checkIdentical(isDirected(sg), TRUE) checkIdentical(nodes(sg), c("a", "x", "y")) checkBAMSubGraph(g1,sg) } test_BAMSubGraph_Large <- function() { g1 <- randBAMGraph(100,100) sn <- sample(nodes(g1), 55) sg <- subGraph( sn, g1) checkIdentical(isDirected(sg), TRUE) checkBAMSubGraph(g1,sg) } test_BAM_edgeWeights <- function() { g1 <- make_smallBAM() ew1 <- edgeWeights(g1) checkEquals(names(ew1), c("a", "b", "c", "x", "y")) checkEquals(list(ew1$a, ew1$b, ew1$c, ew1$x, ew1$y), list(structure( c(3.4, 2.6, 1.7), names = c("b","c","x")), numeric(0), structure(c(7.9), names = "a"), structure(c(1.6, 5.3), names= c("c", "y")), numeric(0))) ew2 <- edgeWeights(g1,c("a","b")) ##index = char checkEquals(names(ew2), c("a","b")) checkEquals(list(ew2$a, ew2$b), list(structure( c(3.4, 2.6, 1.7), names = c("b","c","x")), numeric(0))) ew2 <- edgeWeights(g1, 1:2) ##index = numeric checkEquals(names(ew2), c("a","b")) checkEquals(list(ew2$a, ew2$b), list(structure( c(3.4, 2.6, 1.7), names = c("b","c","x")), numeric(0))) } test_BAM_edgeWeights_undirected <- function() { from = c("a", "d", "d", "b", "a") to = c("b", "a", "d", "c", "c") weight = c(1.5, 2.1, 3.4, 4.1, 5.6) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) gu <- graphBAM(df, nodes="e", edgemode = "undirected") want <- list(a=c(b=1.5, c=5.6, d=2.1), b=c(a=1.5, c=4.1), c=c(a=5.6, b=4.1), d=c(a=2.1, d=3.4), e=numeric(0)) checkEquals(want, edgeWeights(gu)) checkEquals(want[c("c", "a")], edgeWeights(gu, c("c", "a"))) } test_BAM_edges <- function() { g1 <- make_smallBAM() ew1 <- edges(g1) checkEquals(names(ew1), c("a", "b", "c", "x", "y")) checkEquals(list(ew1$a, ew1$b, ew1$c, ew1$x, ew1$y), list( c("b","c","x"), character(0), "a", c("c", "y"), character(0))) ew2 <- edges(g1, c("c", "b")) checkEquals(names(ew2), c("c","b")) checkEquals(list(ew2$c, ew2$b), list("a", character(0))) } test_BAM_adj <- function() { g1 <- make_smallBAM() ew <- adj(g1, c("c", "b")) checkEquals(names(ew), c("c","b")) checkEquals(list(ew$c, ew$b), list("a", character(0))) } test_BAM_edgeMatrix <- function() { g1 <- make_smallBAM() em <- edgeMatrix(g1) checkEquals(em[1,], c(3, 1, 1, 4, 1, 4)) checkEquals(em[2,], c(1, 2, 3, 3, 4, 5)) } test_BAM_adjacencyMatrix <- function() { g1 <- make_smallBAM() checkEquals(edgemode(g1), "directed") checkEquals(nodes(g1), c("a","b","c","x","y")) am <- adjacencyMatrix(g1) checkEquals(rownames(am), nodes(g1)) checkEquals(colnames(am), nodes(g1)) checkEquals(as.integer(am["a",]), c(0, 1, 1, 1, 0)) checkEquals(as.integer(am["b",]), c(0, 0, 0, 0, 0)) checkEquals(as.integer(am["c",]), c(1, 0, 0, 0, 0)) checkEquals(as.integer(am["x",]), c(0, 0, 1, 0, 1)) checkEquals(as.integer(am["y",]), c(0, 0, 0, 0, 0)) } test_BAM_removeEdge_unknown_nodes <- function() { g1 <- make_smallBAM() checkException(removeEdge("a", "q", g1), silent=TRUE) checkException(removeEdge("q", "a", g1), silent=TRUE) checkException(removeEdge("a", c("q", "aa", "tt"), g1), silent=TRUE) checkException(removeEdge(c("a", "q", "tt", "aa"), c("a", "q", "aa", "tt"), g1), silent=TRUE) } test_BAM_removeEdge <- function() { g1 <- make_smallBAM() ## removing nothing does nothing c0 <- character(0) checkEquals(edges(g1), edges(removeEdge(c0, c0, g1))) ## there is no y => a edge, throw error checkException(removeEdge("y", "a", g1), silent=TRUE) g2 <- removeEdge("c", "a", g1) checkEquals(list(c=character(0)), edges(g2, "c")) em <- edgeMatrix(g2) checkEquals(em[1,], c(1, 1, 4, 1, 4)) checkEquals(em[2,], c(2, 3, 3, 4, 5)) g3 <- removeEdge("a", c("b", "x"), g1) checkEquals(list(a="c"), edges(g3, "a")) checkEquals(edges(g1)[-1], edges(g3)[-1]) g4 <- removeEdge(c("a", "x"), "c", g1) checkEquals(list(a=c("b", "x")), edges(g4, "a")) checkEquals(list(x="y"), edges(g4, "x")) } test_BAMSmall_edgeData <- function(){ g1 <- make_smallBAM() eg <- edgeData(g1) tmp <- paste(c("c", "a", "a", "x", "a", "x"), c("a","b","c","c","x","y"),sep="|") checkEquals(names(eg), tmp) vals <- sapply( names(eg),function(k){ eg[[k]]$weight }) checkEquals(names(vals), tmp) checkEquals( as.numeric(vals),c(7.9, 3.4, 2.6, 1.6, 1.7, 5.3)) eg <- edgeData(g1, "a", attr="weight") tmp <- paste( c("a", "a", "a"), c("b", "c", "x"), sep = "|") checkEquals(names(eg), tmp) vals <- sapply( names(eg),function(k){ eg[[k]] }) checkEquals(names(vals), tmp) checkEquals( as.numeric(vals), c(3.4, 2.6, 1.7)) checkException(eg <- edgeData(g1, "a", attr="weightsss"), silent=TRUE) eg <- edgeData(g1, "a", "b", attr="weight") tmp <- paste("a", "b", sep = "|") checkEquals(names(eg), tmp) vals <- sapply( names(eg),function(k){ eg[[k]] }) checkEquals(names(vals), tmp) checkEquals( as.numeric(vals),3.4) } test_BAM_extractFromToUndirected <- function() { g1 <- make_unDirectedBAM() ft <- extractFromTo(g1) checkEquals(as.character(ft$from), c("a", "a", "c", "a", "c", "x")) checkEquals(as.character(ft$to), c("b", "c", "d", "x", "x", "y")) checkEquals(ft$weight, c(3.4, 2.6, 7.9, 1.7, 1.6, 5.3)) } test_BAM_extractFromToDirected <- function() { g1 <- make_smallBAM() ft <- extractFromTo(g1) checkEquals(as.character(ft$from), c("c", "a", "a", "x", "a", "x")) checkEquals(as.character(ft$to), c("a", "b", "c", "c", "x", "y")) checkEquals(ft$weight, c(7.9, 3.4, 2.6, 1.6, 1.7, 5.3)) } test_BAM_bamToMatrix_UnDirected <- function() { g1 <- make_unDirectedBAM() mat <- as(g1, "matrix") checkEquals(isSymmetric(mat), TRUE) checkEquals(mat[upper.tri(mat)], c(3.4, 2.6, 0.0, 0.0, 0.0, 7.9, 1.7, 0.0, 1.6, 0.0, 0.0, 0.0, 0.0, 0.0, 5.3)) checkEquals(rownames(mat),colnames(mat)) checkEquals(rownames(mat), c("a", "b", "c", "d", "x", "y")) } test_BAM_bamToMatrix_Directed <- function() { g1 <- make_smallBAM() mat <- as(g1, "matrix") checkEquals(as.numeric(mat), c(0.0, 0.0, 7.9, 0.0, 0.0, 3.4, 0.0, 0.0, 0.0, 0.0, 2.6, 0.0, 0.0, 1.6, 0.0, 1.7, 0.0, 0.0, 0.0,0.0, 0.0, 0.0, 0.0, 5.3, 0.0)) checkEquals(rownames(mat),colnames(mat)) checkEquals(rownames(mat), c("a","b", "c", "x","y")) } test_BAM_bamTographAM_unDirected <- function() { g1 <- make_unDirectedBAM() am <- as(g1,"graphAM") checkEquals(nodes(g1), nodes(am)) checkEquals(edgemode(g1), edgemode(am)) checkEquals(edges(g1), edges(am)) w1 <- edgeWeights(g1) w2 <- edgeWeights(am) checkEquals(names(w1), names(w2)) checkEquals( w1$a, w2$a) checkEquals( w1$b, w2$b) checkEquals( sort(w1$c), sort(w2$c)) checkEquals( w1$d, w2$d) checkEquals( sort(w1$x), sort(w2$x)) checkEquals( w1$y, w2$y) } test_BAM_bamTographAM_Directed <- function() { g1 <- make_smallBAM() am <- as(g1,"graphAM") checkEquals(nodes(g1), nodes(am)) checkEquals(edgemode(g1), edgemode(am)) checkEquals(edges(g1), edges(am)) w1 <- edgeWeights(g1) w2 <- edgeWeights(am) checkEquals(names(w1), names(w2)) checkEquals( w1$a, w2$a) checkEquals( w1$b, w2$b) checkEquals( sort(w1$c), sort(w2$c)) checkEquals( w1$d, w2$d) checkEquals( sort(w1$x), sort(w2$x)) checkEquals( w1$y, w2$y) } test_BAM_bamTographNEL_UnDirected <- function() { g1 <- make_unDirectedBAM() nel <- as(g1,"graphNEL") checkEquals(nodes(g1), nodes(nel)) checkEquals(edgemode(g1), edgemode(nel)) checkEquals(edges(g1), edges(nel)) w1 <- edgeWeights(g1) w2 <- edgeWeights(nel) checkEquals(names(w1), names(w2)) checkEquals( w1$a, w2$a) checkEquals( w1$b, w2$b) checkEquals( sort(w1$c), sort(w2$c)) checkEquals( w1$d, w2$d) checkEquals( sort(w1$x), sort(w2$x)) checkEquals( w1$y, w2$y) } test_BAM_bamTographNEL_Directed <- function() { g1 <- make_smallBAM() nel <- as(g1,"graphNEL") checkEquals(nodes(g1), nodes(nel)) checkEquals(edgemode(g1), edgemode(nel)) checkEquals(edges(g1), edges(nel)) w1 <- edgeWeights(g1) w2 <- edgeWeights(nel) checkEquals(names(w1), names(w2)) checkEquals( w1$a, w2$a) checkEquals( w1$b, w2$b) checkEquals( sort(w1$c), sort(w2$c)) checkEquals( w1$d, w2$d) checkEquals( sort(w1$x), sort(w2$x)) checkEquals( w1$y, w2$y) } create_GraphNEL_Directed <- function() { set.seed(123) V <- letters[1:4] edL <- vector("list", length=4) names(edL) <- V edL[["a"]] <- list(edges=c(3, 4), weights=c(.13, .14)) edL[["b"]] <- list(edges=c(3), weights=.23) edL[["c"]] <- list(edges=numeric(0), weights=numeric(0)) edL[["d"]] <- list(edges=c(2, 3), weights=c(.42, .43)) gR <- graphNEL(nodes = V, edgeL = edL, edgemode = "directed" ) gR } create_GraphNEL_UnDirected <- function() { set.seed(123) V <- letters[1:4] edL <- vector("list", length=4) names(edL) <- V edL[["a"]] <- list(edges=c(2, 3), weights=c(.13, .14)) edL[["b"]] <- list(edges=c(1), weights=.13) edL[["c"]] <- list(edges=c(1), weights=0.14) edL[["d"]] <- list(edges= numeric(0), weights=numeric(0)) gR <- graphNEL(nodes = V, edgeL = edL, edgemode = "undirected" ) gR } test_graphNEL_Directed_To_graphBAM <-function() { nel <- create_GraphNEL_Directed() bam <- as(nel, "graphBAM") checkEquals(nodes(nel), nodes(bam)) checkEquals(edgemode(nel), edgemode(bam)) checkEquals(edges(nel), edges(bam)) w1 <- edgeWeights(nel) w2 <- edgeWeights(bam) checkEquals(w1,w2) } test_graphNEL_Directed_To_graphBAM <- function() { nel <- create_GraphNEL_Directed() bam <- as(nel, "graphBAM") checkEquals(nodes(nel), nodes(bam)) checkEquals(edgemode(nel), edgemode(bam)) checkEquals(edges(nel), edges(bam)) w1 <- edgeWeights(nel) w2 <- edgeWeights(bam) checkEquals(w1,w2) } test_graphNEL_UnDirected_To_graphBAM <- function() { nel <- create_GraphNEL_UnDirected() bam <- as(nel, "graphBAM") checkEquals(nodes(nel), nodes(bam)) checkEquals(edgemode(nel), edgemode(bam)) checkEquals(edges(nel), edges(bam)) w1 <- edgeWeights(nel) w2 <- edgeWeights(bam) checkEquals(w1,w2) } test_graphAM_Directed_To_graphBAM <- function() { nel <- create_GraphNEL_Directed() am <- as(nel, "graphAM") bam <- as(am, "graphBAM") checkEquals(nodes(am), nodes(bam)) checkEquals(edgemode(am), edgemode(bam)) checkEquals(edges(am), edges(bam)) w1 <- edgeWeights(am) w2 <- edgeWeights(bam) checkEquals(w1,w2) } test_graphAM_UnDirected_To_graphBAM<- function() { nel <- create_GraphNEL_UnDirected() am <- as(nel, "graphAM") bam <- as(am, "graphBAM") checkEquals(nodes(am), nodes(bam)) checkEquals(edgemode(am), edgemode(bam)) checkEquals(edges(am), edges(bam)) w1 <- edgeWeights(am) w2 <- edgeWeights(bam) checkEquals(w1, w2) } test_BAM_set_edge_weights <- function() { getw <- function(x) unlist(edgeWeights(x)) g <- make_smallBAM() weight0 <- unlist(edgeWeights(g)) edgeData(g, "c", "a", attr="weight") <- 123.0 want <- weight0 want["c.a"] <- 123.0 checkEquals(want, getw(g)) g <- make_smallBAM() edgeData(g, "a", c("b", "c", "x"), attr="weight") <- c(10, 11, 12) want <- weight0 want[c("a.b", "a.c", "a.x")] <- c(10, 11, 12) checkEquals(want, getw(g)) } test_BAM_Intersect_UnDirected <- function() { ## nodes a b c d x y from = c("a", "b", "d", "d") to = c("b", "c", "x", "y") weight=c(1.2, 2.4, 3.2, 5.4) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g1 <- graphBAM(df, edgemode = "undirected") ## nodes a b c d x y z from = c("a", "b", "b", "d", "d") to = c("b", "c", "d", "c", "x") weight=c(3.2, 1.2, 2.1, 3.2, 3.5) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g2 <- graphBAM(df, nodes = c("a","b","c", "d", "x", "y", "z"), edgemode = "undirected") g <- graphIntersect(g1,g2) checkEquals(intersect(nodes(g1), nodes(g2)), nodes(g)) checkEquals(FALSE, isDirected(g)) eg <- edgeData(g) vals <- sapply( names(eg),function(k){ eg[[k]]$weight }) tmp <- paste(c("a", "b", "d", "b", "c", "x"), c("b", "c", "x", "a", "b", "d"), sep= "|") checkEquals(tmp, names(vals)) checkEquals(as.numeric(rep(NA, 6)), as.numeric(vals)) } test_BAM_Intersect_Directed <- function() { ## nodes a b c d x y from = c("a", "b", "d", "d") to = c("b", "c", "x", "y") weight=c(1.2, 2.4, 3.2, 5.4) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g1 <- graphBAM(df, edgemode = "directed") ## nodes a b c d x y z from = c("a", "b", "b", "d", "d") to = c("b", "c", "d", "c", "x") weight=c(1.2, 1.2, 2.1, 3.2, 3.5) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g2 <- graphBAM(df, nodes = c("a","b","c", "d", "x", "y", "z"), edgemode = "directed") g <- graphIntersect(g1,g2) checkEquals(intersect(nodes(g1), nodes(g2)), nodes(g)) checkEquals(TRUE, isDirected(g)) eg <- edgeData(g) vals <- sapply( names(eg),function(k){ eg[[k]]$weight }) tmp <- paste(c("a", "b", "d"), c("b", "c", "x"), sep= "|") checkEquals(tmp, names(vals)) checkEquals(c(1.2, NA, NA), as.numeric(vals)) } test_BAM_Intersect_UnDirected2 <- function() { ## nodes a b d x y from = c("a", "d", "d") to = c("b", "x", "y") weight=c(1.2, 3.2, 5.4) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g1 <- graphBAM(df, edgemode = "undirected") ## nodes a b c d x y z from = c("a", "b", "b", "d", "d") to = c("b", "c", "d", "c", "x") weight=c(3.2, 1.2, 2.1, 5.2, 3.2) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g2 <- graphBAM(df, nodes = c("a","b","c", "d", "x", "y", "z"), edgemode = "undirected") g <- graphIntersect(g1,g2) checkEquals(intersect(nodes(g1), nodes(g2)), nodes(g)) checkEquals(FALSE, isDirected(g)) eg <- edgeData(g) vals <- sapply( names(eg),function(k){ eg[[k]]$weight }) tmp <- paste(c("a", "d", "b", "x"), c("b", "x", "a", "d"), sep= "|") checkEquals(tmp, names(vals)) checkEquals(rep(c(NA,3.2),2), as.numeric(vals)) } test_BAM_Intersect_EmptyEdges <- function() { from = c("a", "d", "d") to = c("b", "x", "y") weight=c(1.2, 3.2, 5.4) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g1 <- graphBAM(df, edgemode = "directed") from = c("h", "i", "j") to = c("b", "x", "y") weight=c(1.2, 3.2, 5.4) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g2 <- graphBAM(df, edgemode = "directed") g <- graphIntersect(g1,g2) checkEquals(nodes(g), intersect(nodes(g1), nodes(g2))) checkEquals(isDirected(g), TRUE) eg <- edgeWeights(g) checkEquals(c("b", "x", "y"), names(eg)) checkEquals(list(numeric(0), numeric(0), numeric(0)),list(eg$b, eg$x, eg$y)) } test_BAM_Intersect_EmptyNodes <- function() { from = c("a", "d", "d") to = c("b", "x", "y") weight=c(1.2, 3.2, 5.4) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g1 <- graphBAM(df, edgemode = "unirected") from = c("h", "i", "j") to = c("s", "h", "l") weight=c(1.2, 3.2, 5.4) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g2 <- graphBAM(df, edgemode = "undirected") g <- graphIntersect(g1,g2) checkEquals(intersect(nodes(g1), nodes(g2)), nodes(g)) checkEquals(FALSE, isDirected(g)) eg <- edgeWeights(g) checkEquals(list(), eg) } test_BAM_isAdjacent <- function() { from = c("a", "d", "d", "b", "a") to = c("b", "a", "d", "c", "c") weight= c(1.5, 2.1, 3.4, 4.1, 5.6) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) gd <- graphBAM(df, nodes="e", edgemode = "directed") ## single edges for (i in seq_len(nrow(df))) { checkEquals(TRUE, isAdjacent(gd, from[i], to[i])) } ## vectorized checkEquals(c(FALSE, TRUE, TRUE, FALSE, FALSE), isAdjacent(gd, "a", letters[1:5])) checkEquals(c(FALSE, FALSE, FALSE, TRUE, FALSE), isAdjacent(gd, letters[1:5], "a")) } test_BAM_Union_UnDirected <- function() { ## nodes a b c d x y from = c("a", "b", "d", "d") to = c("b", "c", "x", "y") weight=c(1.2, 2.4, 3.5, 5.4) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g1 <- graphBAM(df, edgemode = "undirected") ## nodes a b c d x y z from = c("a", "b", "b", "d", "d") to = c("b", "c", "d", "c", "x") weight=c(3.2, 1.2, 2.1, 3.2, 3.5) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g2 <- graphBAM(df, nodes = c("a","b","c", "d", "x", "y", "z"), edgemode = "undirected") g <- graphUnion(g1,g2) checkEquals(union(nodes(g1), nodes(g2)), nodes(g)) checkEquals(FALSE, isDirected(g)) df <- extractFromTo(g) tmp <- data.frame(from = c("a", "b", "b", "c", "d", "d"), to = c("b", "c", "d", "d", "x", "y"), weight = c( NA, NA, 2.1, 3.2, 3.5, 5.4), stringsAsFactors = TRUE) checkEquals(tmp, df) } test_BAM_Union_Directed <- function() { ## nodes a b c d x y from = c("a", "b", "d", "d") to = c("b", "c", "x", "y") weight=c(1.2, 2.4, 3.5, 5.4) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g1 <- graphBAM(df, edgemode = "directed") ## nodes a b c d x y z from = c("a", "b", "b", "d", "d") to = c("b", "c", "d", "c", "x") weight=c(1.2, 1.2, 2.1, 3.2, 3.5) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g2 <- graphBAM(df, nodes = c("a","b","c", "d", "x", "y", "z"), edgemode = "directed") g <- graphUnion(g1,g2) checkEquals(union(nodes(g1), nodes(g2)), nodes(g)) checkEquals(TRUE, isDirected(g)) df <- extractFromTo(g) tmp <- data.frame(from = c("a", "b", "d", "b", "d", "d"), to = c("b", "c", "c", "d", "x", "y"), weight = c( 1.2, NA, 3.2, 2.1, 3.5, 5.4), stringsAsFactors = TRUE) checkEquals(tmp, df) } test_BAM_Union_Mixed <- function() { ## nodes a b d x y from = c("a", "d", "d") to = c("b", "x", "y") weight=c(1.2, 3.2, 5.4) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g1 <- graphBAM(df, edgemode = "undirected") ## nodes a b c d x y z from = c("a", "b", "b", "d", "d") to = c("b", "c", "d", "c", "x") weight=c(3.2, 1.2, 2.1, 3.2, 3.5) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g2 <- graphBAM(df, nodes = c("a","b","c", "d", "x", "y", "z"), edgemode = "directed") checkException(g <- graphUnion(g1,g2), silent=TRUE) } test_BAM_inEdges <- function() { from = c("a", "d", "d", "b", "a") to = c("b", "a", "d", "c", "c") weight = c(1.5, 2.1, 3.4, 4.1, 5.6) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) ## directed gd <- graphBAM(df, nodes="e", edgemode = "directed") want <- list(a="d", b="a", c=c("a", "b"), d="d", e=character(0)) checkEquals(want, inEdges(nodes(gd), gd)) ## undirected gu <- graphBAM(df, nodes="e", edgemode = "undirected") checkEquals(edges(gu), inEdges(nodes(gu), gu)) } test_BAM_directed_attrs <- function() { from = c("a", "a", "a", "x", "x", "c") to = c("b", "c", "x", "y", "c", "a") weight = c(2, 1, 3, 4, 5, 6) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) bam <- graphBAM(df, edgemode = "directed") checkException(edgeData(bam,from="a", attr="code"), silent=TRUE) edgeDataDefaults(bam, attr ="weight") <- 1 edgeDataDefaults(bam, attr = "code") <- "plain" res <- unlist(edgeData(bam,from="a", attr="code")) nmres <- paste(c("a","a","a"), c ("b", "c", "x"), sep="|") checkEquals(names(res), nmres) checkEquals(as.character(res), c("plain", "plain", "plain")) edgeData(bam,from = "a", to = "x", attr= "code") <- "red" res <- unlist(edgeData(bam, from = "a", attr = "code")) checkEquals(names(res), nmres) checkEquals(as.character(res), c("plain", "plain", "red")) edgeData(bam,to = "c", attr= "code") <- "yellow" res <- unlist(edgeData(bam, to= "c", attr = "code")) nmres <- paste(c("a", "x"), c("c", "c"), sep = "|") checkEquals(names(res), nmres) checkEquals(as.character(res), c("yellow", "yellow")) } test_BAM_undirected_attrs <- function() { from = c("a", "a", "a", "x", "x") to = c("b", "c", "x", "y", "c") weight = c(2, 1, 3, 4, 5) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) bam <- graphBAM(df, edgemode = "undirected") checkException(edgeData(bam,from="a", attr="code"), silent=TRUE) edgeDataDefaults(bam, attr = "weight") <- 1 edgeDataDefaults(bam, attr = "code") <- "plain" res <- unlist(edgeData(bam,from="a", attr="code")) nmres <- paste(c("a","a","a"), c ("b", "c", "x"), sep="|") checkEquals(names(res), nmres) checkEquals(as.character(res), c("plain", "plain", "plain")) edgeData(bam,from = "a", to = "x", attr= "code") <- "red" res <- unlist(edgeData(bam, from = "a", attr = "code")) checkEquals(names(res), nmres) checkEquals(as.character(res), c("plain", "plain", "red")) edgeData(bam,to = "c", attr= "code") <- "yellow" res <- unlist(edgeData(bam, to= "c", attr = "code")) nmres <- paste(c("a", "x"), c("c", "c"), sep = "|") checkEquals(names(res), nmres) checkEquals(as.character(res), c("yellow", "yellow")) } test_graphBAM_detailed_Attribute_Intersection <- function() { ## nodes a b c d x y from = c("a", "b", "d", "d") to = c("b", "c", "y", "x") weight=c(1.2, 2.4, 5.4, 3.2) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g1 <- graphBAM(df, edgemode = "directed") edgeData(g1, from = from, to = to ,attr = "weight") <- c(1.2, 2.4, 5.4, 3.2) edgeDataDefaults(g1, attr = "color") <- "unknown" edgeDataDefaults(g1, attr ="type") <- "unknown" edgeData(g1, from = from, to = to ,attr = "color") <- c("red", "blue", NA, "green") edgeData(g1, from = from, to = to , attr = "type") <- c("high", "low", "high", NA) ## nodes a b c d x y z from = c("a", "b", "b", "d", "d") to = c("b", "c", "d", "c", "x") weight=c(1.2, 4.2, 5.6, 2.1, 3.2) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g2 <- graphBAM(df, nodes = c("a","b","c", "d", "x", "y", "z"), edgemode = "directed") edgeDataDefaults(g2, attr = "color") <- "unknown" edgeData(g2, from = from, to = to, attr = "color") <- c("red", "blue", NA, "red", "yellow") g <- graphIntersect(g1, g2) df <- extractFromTo(g) tmp <- data.frame( from = c("a", "b", "d"), to = c("b", "c", "x"), weight = c(1.2, NA, 3.2), stringsAsFactors = TRUE) checkEquals(tmp, df) attColor <- edgeData(g, attr = "color") nms <- paste(c("a", "b", "d"), c("b", "c", "x"), sep = "|") target <- structure( c("red", "blue", NA), names = nms) checkEquals(target, unlist(attColor)) checkException(edgeData(g, attr = "type"), silent=TRUE) weightFun <- function(x, y) { return(x +y ) } colorFun <- function(x,y) { if(x=="red" && y == "red") return("white") else return("black") } setClass("myType", representation = representation(typ ="character")) myType <- function(typ){ new("myType", typ = typ)} typeFun <- function(x,y) { if(is(x, "myType") && is(y, "myType")){ if(x@typ =="low" || y@typ == "med") return("low") else return("high") } else {return (NA)} } nodeDataDefaults(g1, attr ="color") <- "unknown" nodeDataDefaults(g1, attr ="type") <- "unknown" nodeDataDefaults(g2, attr ="color") <- "unknown" nodeDataDefaults(g2, attr ="type") <- "unknown" nodeData(g1,n = c("a", "b", "c"), attr ="color") <- c("red", "green", "blue") nodeData(g1,n = c("b", "c"), attr ="type") <- c(myType("low"), myType("high")) nodeData(g2,n = c("a", "b", "c"), attr ="color") <- c("red", "green", "red") nodeData(g2,n = c("b", "c"), attr ="type") <- c(myType("med"), myType("low")) g <- graphIntersect(g1, g2, nodeFun = list(type = typeFun), edgeFun = list(weight = weightFun, color = colorFun)) attWeight <- edgeData(g, attr = "weight") nms <- paste(c("a", "b", "d"), c("b", "c", "x"), sep = "|") target <- structure( c( 2.4, 6.6, 6.4), names = nms) checkEquals(target, unlist(attWeight)) attColor <- edgeData(g, attr = "color") nms <- paste(c("a", "b", "d"), c("b", "c", "x"), sep = "|") target <- structure( c( 2.4, 6.6, 6.4), names = nms) checkEquals(target, unlist(attWeight)) nodeColor <- nodeData(g, attr = "color") target <- as.list(structure(c("red", "green", NA, "unknown", "unknown", "unknown"), names = c("a", "b", "c", "d", "x", "y"))) checkEquals(target, nodeColor) nodeType <- nodeData(g, attr = "type") target <- as.list(structure(c("unknown", "low", "high", "unknown", "unknown", "unknown"), names = c("a", "b", "c", "d", "x", "y"))) checkEquals(target, nodeType) } test_graphBAM_detailed_Attribute_Union <- function() { ## nodes a b c d x y from = c("a", "b", "d", "d") to = c("b", "c", "y", "x") weight=c(1.2, 2.4, 5.4, 3.2) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g1 <- graphBAM(df, edgemode = "directed") edgeData(g1, from = from, to = to ,attr = "weight") <- c(1.2, 2.4, 5.4, 3.2) edgeDataDefaults(g1, attr = "color") <- "cyan" edgeDataDefaults(g1, attr = "type") <- "unknown" edgeData(g1, from = from, to = to ,attr = "color") <- c("red", "blue", NA, "green") edgeData(g1, from = from, to = to , attr = "type") <- c("high", "low", "high", NA) ## nodes a b c d x y z from = c("a", "b", "b", "d", "d") to = c("b", "c", "d", "c", "x") weight=c(1.2, 4.2, 5.6, 2.1, 3.2) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g2 <- graphBAM(df, nodes = c("a","b","c", "d", "x", "y", "z"), edgemode = "directed") edgeDataDefaults(g2, attr = "color") <- "cyan" edgeData(g2, from = from, to = to, attr = "color") <- c("red", "blue", NA, "red", "yellow") g <- graphUnion(g1, g2) df <- extractFromTo(g) tmp <- data.frame( from = c("a", "b", "d", "b", "d", "d"), to = c("b", "c", "c", "d", "x", "y"), weight = c(1.2, NA, 2.1, 5.6, 3.2, 5.4), stringsAsFactors = TRUE) checkEquals(tmp, df) attColor <- edgeData(g, attr = "color") nms <- paste(c("a", "b", "d", "b", "d", "d"), c("b", "c", "c", "d", "x", "y"), sep = "|") target <- structure( c("red", "blue", "red", NA, NA, NA), names = nms) checkEquals(target, unlist(attColor)) attType <- edgeData(g, attr = "type") nms <- paste(c("a", "b", "d", "b", "d", "d"), c("b", "c", "c", "d", "x", "y"), sep = "|") target <- structure( c("high", "low", NA, NA, NA, "high"), names = nms) checkEquals(target, unlist(attType)) weightFun <- function(x, y) { return(x + y ) } colorFun <- function(x,y) { if(x=="red" || y == "red") return("white") else return("black") } setClass("myType", representation = representation(typ ="character")) myType <- function(typ){ new("myType", typ = typ)} typeFun <- function(x,y) { if(is(x, "myType") && is(y, "myType")){ if(x@typ =="low" || y@typ == "med") return("low") else return("high") } else {return (NA)} } nodeDataDefaults(g1, attr ="color") <- "cyan" nodeDataDefaults(g1, attr="type") <- "unknown" nodeData(g1,n = c("a", "b", "c"), attr ="color") <- c("red", "green", "blue") nodeData(g1,n = c("b", "c"), attr ="type") <- c(myType("low"), myType("high")) nodeDataDefaults(g2, attr ="color") <- "cyan" nodeDataDefaults(g2, attr="type") <- "unknown" nodeDataDefaults(g2, attr="test") <- "missing" nodeData(g2,n = c("a", "b", "c", "z"), attr ="color") <- c("red", "green", "red","pink") nodeData(g2,n = c("b", "c"), attr ="type") <- c(myType("med"), myType("low")) nodeData(g2,n = c("a", "b", "c"), attr = "test") <- c("pass", "fail", "pass") g <- graphUnion(g1, g2, edgeFun = list(weight = weightFun, color = colorFun)) attWeight <- edgeData(g, attr = "weight") nms <- paste(c("a", "b", "d", "b", "d", "d"), c("b", "c", "c", "d", "x", "y"), sep = "|") target <- structure( c( 2.4, 6.6, 2.1, 5.6, 6.4, 5.4), names = nms) checkEquals(target, unlist(attWeight)) attColor <- edgeData(g, attr = "color") nms <- paste(c("a", "b", "d", "b", "d", "d"), c("b", "c", "c", "d", "x", "y"), sep = "|") target <- structure(c( "white", "black", "red", NA, "black", NA), names = nms) checkEquals( target, unlist(attColor)) attType <- edgeData(g, attr = "type") nms <- paste(c("a", "b", "d", "b", "d", "d"), c("b", "c", "c", "d", "x", "y"), sep = "|") target <- structure( c("high", "low", NA, NA, NA, "high"), names = nms) checkEquals(target, unlist(attType)) attType <- edgeData(g, attr = "type") nms <- paste(c("a", "b", "d", "b", "d", "d"), c("b", "c", "c", "d", "x", "y"), sep = "|") target <- structure( c("high", "low", NA, NA, NA, "high"), names = nms) checkEquals(target, unlist(attType)) } test_graphBAM_removeEdgesByWeight <- function() { from = c("a", "b", "d", "d") to = c("b", "c", "y", "x") weight=c(2.2, 2.0, 0.4, 0.2) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g <- graphBAM(df, edgemode = "directed") edgeDataDefaults(g, attr="color") <- "pink" edgeData(g, from = from, to = to ,attr = "color") <- c("red", "blue", NA, "green") res <- removeEdgesByWeight(g, lessThan = 2.0) checkEquals(attr(res@edgeSet@bit_vector, "nbitset"), 2) checkEquals(res@edgeSet@weights, c(2.2, 2.0)) current <- unlist( edgeData(res, attr = "color")) target <- structure(c("red", "blue"), names = paste(c("a", "b"), c("b", "c"), sep = "|")) checkEquals(target, current) res <- removeEdgesByWeight(g, greaterThan = 1.9) checkEquals(attr(res@edgeSet@bit_vector, "nbitset"), 2) checkEquals(res@edgeSet@weights, c(0.2, 0.4)) current <- unlist( edgeData(res, attr = "color")) target <- structure(c("green", NA), names = paste(c("d", "d"), c("x", "y"), sep = "|")) checkEquals(target, current) res <- removeEdgesByWeight(g, lessThan =1.0, greaterThan = 2) checkEquals(res@edgeSet@weights, c(2.0)) current <- unlist( edgeData(res, attr = "color")) target <- structure(c("blue"), names = paste( "b", "c", sep = "|")) checkEquals(target, current) res <- removeEdgesByWeight(g, greaterThan = 0.1) checkEquals(res@edgeSet@weights, numeric(0)) checkEquals(res@edgeSet@edge_attrs$color, character(0)) } test_graphBAM_nodeAttributes <- function(){ from = c("a", "b", "d", "d") to = c("b", "c", "y", "x") weight=c(2.2, 2.0, 0.4, 0.2) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g <- graphBAM(df, edgemode = "directed") nodeDataDefaults(g, attr ="color") <- "blue" sg <- subGraph(c("a", "c"), g) checkIdentical(unname(unlist(nodeData(sg))), c("blue", "blue")) nodeData(g, n = c("d","a"), attr = "color") <- c("red", "green") current <- nodeData(g, attr = "color") target <- as.list(structure( c("green", "blue", "blue", "red", "blue", "blue"), names = c("a", "b", "c", "d", "x", "y"))) checkEquals(target, current) nodeDataDefaults(g, attr="mat") <- NA nodeData(g, n= c("x", "y"), attr = "mat") <- df current <- nodeData(g, n= c("x", "y"), attr = "mat") target <- list(x = df, y = df) checkEquals(target, current) sg <- subGraph(c("d","b"), g) current <- nodeData(sg, attr = "color") target <- as.list(structure(c("blue", "red"), names = c("b", "d"))) checkEquals(target, current) } test_BAM_directed_attrs_s4 <- function() { from = c("a", "a", "a", "x", "x", "c") to = c("b", "c", "x", "y", "c", "a") weight = c(2, 1, 3, 4, 5, 6) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) bam <- graphBAM(df, edgemode = "directed") edgeDataDefaults(bam, attr = "weight") <- 1.3 edgeDataDefaults (bam, attr = "vals") <- df edgeData(bam, from = "a", attr= "vals") <- "unknown" res <- edgeData(bam, attr="vals") nmres <- c("c|a", "a|b", "a|c", "x|c", "a|x", "x|y") target <- structure(list(df, "unknown", "unknown", df, "unknown",df), names = nmres) checkEquals(res, target) edgeDataDefaults(bam, attr = "mat") <- NA edgeData(bam,from = "a", to = "x", attr= "mat") <- matrix(1) res <- edgeData(bam, from = "a", attr = "mat") nmres <- paste(c("a", "a", "a"), c("b", "c", "x"), sep = "|") target <- structure( list(NA, NA, matrix(1)), names = nmres) checkEquals(res, target) edgeDataDefaults(bam, attr = "mk") <- NA edgeData(bam,to = "c", attr= "mk") <- matrix(1) res <- edgeData(bam, attr = "mk") nmres <- paste(c("c", "a", "a", "x", "a", "x"), c("a", "b", "c", "c", "x", "y"), sep ="|") target <- structure( list(NA, NA, matrix(1), matrix(1), NA ,NA), names = nmres) checkEquals(res, target) } test_BAM_undirected_attrs_s4 <- function() { from = c("a", "a", "a", "x") to = c("b", "c", "x", "y") weight = c(2, 1, 3, 4) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) bam <- graphBAM(df, edgemode = "undirected") edgeDataDefaults(bam, attr = "weight") <- 1.3 edgeDataDefaults(bam, attr = "vals") <- df # edgeData(bam, attr = "weight") <- 1.3 # edgeData(bam, attr = "vals") <- df edgeData(bam, from = "x", attr = "vals") <- "unknown" res <- edgeData(bam, attr="vals") nmres <- c("a|b", "a|c", "a|x", "x|y", "b|a", "c|a", "x|a", "y|x") target <- structure(list(df, df, "unknown", "unknown", df, df, "unknown", "unknown"), names = nmres) checkEquals(res, target) edgeDataDefaults(bam, attr ="mat") <- NA edgeData(bam,from = "a", to = "x", attr= "mat") <- matrix(1) res <- edgeData(bam, attr = "mat") target <- structure(list(NA, NA, matrix(1), NA, NA, NA, matrix(1), NA), names = nmres) checkEquals(res, target) edgeDataDefaults(bam, attr = "mk") <- NA edgeData(bam,to = "c", attr= "mk") <- matrix(1) res <- edgeData(bam, attr = "mk") target <- structure( list(NA, matrix(1), NA, NA, NA, matrix(1), NA ,NA), names = nmres) checkEquals(res, target) } test_graphBAM_S4_Attribute_Intersection <- function() { setClass("myColor", representation = representation(col ="character")) setClass("myType", representation = representation(typ ="character")) myColor <- function(col){ new("myColor", col = col)} myType <- function(typ){ new("myType", typ = typ)} ## nodes a b c d x y from = c("a", "b", "d", "d") to = c("b", "c", "y", "x") weight=c(1.2, 2.4, 5.4, 3.2) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g1 <- graphBAM(df, edgemode = "directed") edgeData(g1, from = from, to = to ,attr = "weight") <- c(1.2, 2.4, 5.4, 3.2) edgeDataDefaults(g1, attr="color") <- "cyan" edgeDataDefaults(g1, attr="type") <- "unknown" edgeData(g1, from = from, to = to ,attr = "color") <- c(myColor("red"), myColor("blue"), NA, myColor("green")) edgeData(g1, from = from, to = to , attr = "type") <- c(myType("high"), myType("low"), myType("high"), NA) ## nodes a b c d x y z from = c("a", "b", "b", "d", "d") to = c("b", "c", "d", "c", "x") weight=c(1.2, 4.2, 5.6, 2.1, 3.2) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g2 <- graphBAM(df, nodes = c("a","b","c", "d", "x", "y", "z"), edgemode = "directed") edgeDataDefaults(g2, attr ="color") <- "cyan" edgeData(g2, from = from, to = to, attr = "color") <- c(myColor("red"), myColor("blue"), NA, myColor("red"), myColor("yellow")) g <- graphIntersect(g1, g2) df <- extractFromTo(g) tmp <- data.frame( from = c("a", "b", "d"), to = c("b", "c", "x"), weight = c(1.2, NA, 3.2), stringsAsFactors = TRUE) checkEquals(tmp, df) attColor <- edgeData(g, attr = "color") nms <- paste(c("a", "b", "d"), c("b", "c", "x"), sep = "|") target <- structure( c(myColor("red"), myColor("blue"), NA), names = nms) checkEquals(target, unlist(attColor)) checkException(edgeData(g, attr = "type"), silent=TRUE) weightFun <- function(x, y) { return(x + y ) } colorFun <- function(x,y) { if(x@col=="red" && y@col == "red") return("white") else return("black") } g <- graphIntersect(g1, g2, edgeFun =list(weight = weightFun, color = colorFun)) df <- extractFromTo(g) tmp <- data.frame( from = c("a", "b", "d"), to = c("b", "c", "x"), weight = c(2.4, 6.6 , 6.4), stringsAsFactors = TRUE) checkEquals(tmp, df) attColor <- edgeData(g, attr = "color") nms <- paste(c("a", "b", "d"), c("b", "c", "x"), sep = "|") target <- structure( c("white", "black", "black"), names = nms) checkEquals(target, unlist(attColor)) checkException(edgeData(g, attr = "type"), silent=TRUE) } test_graphBAM_S4_Attribute_Union <- function() { setClass("myColor", representation = representation(col ="character")) setClass("myType", representation = representation(typ ="character")) myColor <- function(col){ new("myColor", col = col)} myType <- function(typ){ new("myType", typ = typ)} ## nodes a b c d x y from = c("a", "b", "d", "d") to = c("b", "c", "y", "x") weight=c(1.2, 2.4, 5.4, 3.2) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g1 <- graphBAM(df, edgemode = "directed") edgeData(g1, from = from, to = to ,attr = "weight") <- c(1.2, 2.4, 5.4, 3.2) edgeDataDefaults(g1, attr = "color") <- "cyan" edgeDataDefaults(g1, attr = "type") <- "missing" edgeData(g1, from = from, to = to ,attr = "color") <- c(myColor("red"), myColor("blue"), NA, myColor("green")) edgeData(g1, from = from, to = to , attr = "type") <- c(myType("high"), myType("low"), myType("high"), NA) ## nodes a b c d x y z from = c("a", "b", "b", "d", "d") to = c("b", "c", "d", "c", "x") weight=c(1.2, 4.2, 5.6, 2.1, 3.2) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g2 <- graphBAM(df, nodes = c("a","b","c", "d", "x", "y", "z"), edgemode = "directed") edgeDataDefaults(g2, attr = "color") <- "cyan" edgeData(g2, from = from, to = to, attr = "color") <- c(myColor("red"), myColor("blue"), NA, myColor("red"), myColor("yellow")) g <- graphUnion(g1, g2) df <- extractFromTo(g) tmp <- data.frame( from = c("a", "b", "d", "b", "d", "d"), to = c("b", "c", "c", "d", "x", "y"), weight = c(1.2, NA, 2.1, 5.6, 3.2, 5.4), stringsAsFactors = TRUE) checkEquals(tmp, df) attColor <- edgeData(g, attr = "color") nms <- paste(c("a", "b", "d", "b", "d", "d"), c("b", "c", "c", "d", "x", "y"), sep = "|") target <- structure( c(myColor("red"), myColor("blue"), myColor("red"), NA, NA, NA), names = nms) checkEquals(target, unlist(attColor)) attType <- edgeData(g, attr = "type") nms <- paste(c("a", "b", "d", "b", "d", "d"), c("b", "c", "c", "d", "x", "y"), sep = "|") target <- structure( c(myType("high"), myType("low"), NA, NA, NA, myType("high")), names = nms) checkEquals(target, unlist(attType)) weightFun <- function(x, y) { return(x + y ) } colorFun <- function(x,y) { if(x@col =="red" || y@col == "red") return("white") else return("black") } g <- graphUnion(g1, g2, edgeFun = list(weight = weightFun, color = colorFun)) attWeight <- edgeData(g, attr = "weight") nms <- paste(c("a", "b", "d", "b", "d", "d"), c("b", "c", "c", "d", "x", "y"), sep = "|") target <- structure( c( 2.4, 6.6, 2.1, 5.6, 6.4, 5.4), names = nms) checkEquals(target, unlist(attWeight)) attColor <- edgeData(g, attr = "color") nms <- paste(c("a", "b", "d", "b", "d", "d"), c("b", "c", "c", "d", "x", "y"), sep = "|") target <- structure(c( "white", "black", myColor("red"), NA, "black", NA), names = nms) checkEquals( target, unlist(attColor)) attType <- edgeData(g, attr = "type") nms <- paste(c("a", "b", "d", "b", "d", "d"), c("b", "c", "c", "d", "x", "y"), sep = "|") target <- structure( c(myType("high"), myType("low"), NA, NA, NA, myType("high")), names = nms) checkEquals(target, unlist(attType)) attType <- edgeData(g, attr = "type") nms <- paste(c("a", "b", "d", "b", "d", "d"), c("b", "c", "c", "d", "x", "y"), sep = "|") target <- structure(c( myType("high"), myType("low"), NA, NA, NA, myType("high")), names = nms) checkEquals(target, unlist(attType)) } test_graphBAM_addNode1 <- function(){ from = c("a", "b", "d", "d") to = c("b", "c", "y", "x") weight=c(2.2, 2.0, 0.4, 0.2) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g <- graphBAM(df, edgemode = "directed") nodeDataDefaults(g, attr="color") <- "pink" nodeData(g, n = c("d","a"), attr = "color") <- c("red", "green") nodeDataDefaults(g, attr="type") <- "unknown" nodeData(g, n = c("a", "b", "y", "d"), attr = "type") <- c("high", "med", "high", "low") gr <- addNode(c("q", "ss"), g) current <- nodeData(gr, attr = "color") target <- c("green", "pink", "pink", "red", "pink", "pink", "pink", "pink") names(target) <- c("a", "b", "c", "d", "q", "ss", "x", "y") checkTrue(all(current[sort(names(current))] == target[sort(names(target))])) current <- nodeData(gr, attr = "type") target <- c("high", "med", "unknown", "low", "unknown", "unknown", "unknown", "high") names(target) <- c("a", "b", "c", "d", "q", "ss", "x", "y") checkTrue(all(current[sort(names(current))] == target[sort(names(target))])) } test_graphBAM_addNode1 <- function(){ from = c("a", "b", "d", "d") to = c("b", "c", "y", "x") weight=c(2.2, 2.0, 0.4, 0.2) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g <- graphBAM(df, edgemode = "directed") nodeDataDefaults(g, attr="color") <- "pink" nodeData(g, n = c("d","a"), attr = "color") <- c("red", "green") nodeDataDefaults(g, attr="type") <- "unknown" nodeData(g, n = c("a", "b", "y", "d"), attr = "type") <- c("high", "med", "high", "low") gr <- addNode(c("q", "ss"), g) current <- nodeData(gr, attr = "color") target <- c("green", "pink", "pink", "red", "pink", "pink", "pink", "pink") names(target) <- c("a", "b", "c", "d", "q", "ss", "x", "y") checkTrue(all(current[sort(names(current))] == target[sort(names(target))])) current <- nodeData(gr, attr = "type") target <- c("high", "med", "unknown", "low", "unknown", "unknown", "unknown", "high") names(target) <- c("a", "b", "c", "d", "q", "ss", "x", "y") checkTrue(all(current[sort(names(current))] == target[sort(names(target))])) } test_graphBAM_addNode2 <- function(){ from = c("a", "b", "d", "d") to = c("b", "c", "y", "x") weight=c(2.2, 2.0, 0.4, 0.2) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g <- graphBAM(df, edgemode = "directed") edgeDataDefaults(g, attr="color") <- "blue" edgeDataDefaults(g, attr="type") <- "unknown" edgeData(g, from = c("d","a"), to = c("y", "b"), attr = "color") <- c("red", "green") edgeData(g, from = c("a", "b"), to = c("b", "c") , attr = "type") <- c("low", "high") g1 <- addEdge(from = c("d", "b"), to = c("c", "x"), g, weights = c(4.0, 10.0)) current <- edgeData(g1, attr ="weight") lbl <- paste(c("a", "b", "d", "b", "d", "d"), c( "b", "c", "c", "x", "x", "y") , sep ="|") target <- as.list( structure(c(2.2, 2, 4, 10, 0.2, 0.4), names = lbl)) checkEquals(target, current) current <- edgeData(g1, attr ="color") lbl <- paste(c("a", "b", "d", "b", "d", "d"), c( "b", "c", "c", "x", "x", "y"), sep ="|") target <- as.list( structure(c("green", "blue", "blue", "blue", "blue", "red"), names = lbl)) checkEquals(target, current) current <- edgeData(g1, attr ="type") lbl <- paste(c("a", "b", "d", "b", "d", "d"), c( "b", "c", "c", "x", "x", "y") , sep ="|") target <- as.list( structure(c("low", "high", "unknown", "unknown", "unknown", "unknown"), names = lbl)) checkEquals(target, current) } # in version prior to 1.41.1, the propagation of existing "user" edge attributes, # that is, anything other than weight, failed if a new node is added which is # lexically less than the any nodes already in an edge. # the fix was simple: see arguments to setBitCell in methods-graphBAM.R, # the addNode method. test that fix here test_graphBAM_addNode_outOfAlphabeticalOrder_copyUserEdgeAttributes <- function(){ from = c("a", "b", "m", "m") to = c("b", "c", "y", "x") weight=c(2.2, 2.0, 0.4, 0.2) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g <- graphBAM(df, edgemode = "directed") edgeDataDefaults(g, attr="color") <- "blue" edgeDataDefaults(g, attr="type") <- "unknown" edgeData(g, from = c("m","a"), to = c("y", "b"), attr = "color") <- c("red", "green") edgeData(g, from = c("a", "b"), to = c("b", "c") , attr = "type") <- c("low", "high") expected.edge.names <- c("a|b", "b|c", "m|x", "m|y") checkEquals(sort(names(edgeData(g, attr="color"))), expected.edge.names) checkEquals(unlist(edgeData(g, attr="color")[expected.edge.names], use.names=FALSE), c("green", "blue", "blue", "red")) g2 <- addNode("f", g) # make sure that the addition of node f does not disrupt # edgeData retrieval checkEquals(sort(names(edgeData(g2, attr="color"))), expected.edge.names) checkEquals(unlist(edgeData(g, attr="color")[expected.edge.names], use.names=FALSE), c("green", "blue", "blue", "red")) } test_graphBAM_nodeUnion_Attributes <- function(use.factors=TRUE){ setClass("myType", representation = representation(typ ="character")) myType <- function(typ){ new("myType", typ = typ)} testFun <- function(x,y) { if(is(x, "myType") && is(y, "myType")){ if(x@typ =="aa" || y@typ == "ac") return("ax") else return("ab") } else return(as.character(NA)) } funList <- structure(list(testFun), names ="gene") ft1 <- data.frame(from=c("a", "a", "a", "b", "b"), to =c("b", "c", "d", "a", "d"), weight=c(1, 3.1, 5.4, 1, 2.2), stringsAsFactors = use.factors) g1 <- graphBAM(ft1, edgemode="directed") nodeDataDefaults(g1, attr="color") <- "cyan" nodeDataDefaults(g1, attr="type") <- "missing" nodeDataDefaults(g1, attr="kp") <- "missing" nodeDataDefaults(g1, attr="gene") <- "unknown" nodeData(g1, n = c("a", "b", "c") , attr = "color") <- c("red", "green", "blue") nodeData(g1, n = c("a", "b"), attr = "type") <- c("low", "high") nodeData(g1, n = c("a", "b"), attr = "kp") <- c("kplow", "kphigh") nodeData(g1, n = c("a", "b"), attr = "gene") <- c(myType("aa"), myType("bt")) ft1 <- data.frame(from=c("a", "a", "b"), to=c("b", "x", "z"), weight=c(6, 5, 2), stringsAsFactors = use.factors) g2 <- graphBAM(ft1,nodes = c("a","b", "c", "d", "x", "y", "z"), edgemode = "directed") nodeDataDefaults(g2, attr ="color") <- "cyan" nodeDataDefaults(g2, attr="type") <- "missing" nodeDataDefaults(g2, attr="gene") <- "unknown" nodeData(g2, n = c("a", "b", "x", "y", "z") , attr = "color") <- c("red", "red", "green", "pink", "yellow") nodeData(g2, n = c("a", "b"), attr = "type") <- c("low", "high") nodeData(g2, n = c("a", "b"), attr = "gene") <- c(myType("at"), myType("kt")) res <- graphUnion(g1, g2, nodeFun = funList) current <- nodeData(res, attr = "color") cn <- as.character(NA) target <- as.list( structure(c("red", cn, cn, "cyan", "green", "pink", "yellow"), names = c("a", "b", "c", "d", "x", "y", "z"))) checkEquals(target, current) current <- nodeData(res, attr = "type") target <- as.list( structure(c("low", "high", "missing", "missing", "missing", "missing", "missing"), names = c("a", "b", "c", "d", "x", "y", "z"))) checkEquals(target, current) current <- nodeData(res, attr = "kp") target <- as.list( structure(c("kplow", "kphigh", "missing", "missing", "missing", "missing", "missing"), names = c("a", "b", "c", "d", "x", "y", "z"))) checkEquals(target, current) current <- nodeData(res, n = c("a", "b", "c", "d"), attr ="gene") target <- as.list( structure(c("ax", "ab", cn ,cn), names = c("a", "b", "c", "d"))) checkEquals(target, current) current <- nodeData(res, n= c( "x", "y", "z"), attr ="gene") target <- as.list( structure(c("unknown","unknown", "unknown"), names = c("x", "y", "z"))) checkEquals(target, current) } test_graphBAM_removeNode <- function(){ from = c("a", "b", "d", "d") to = c("b", "c", "y", "x") weight=c(2.2, 2.0, 0.4, 0.2) df <- data.frame(from, to, weight, stringsAsFactors = TRUE) g <- graphBAM(df, edgemode = "directed") nodeDataDefaults(g, attr="name") <- "NN" nodeData(g, n = c("a","b", "c", "d", "x", "y"), attr = "name") <- c("a", "b", "c", "d", "x", "y") edgeDataDefaults(g, attr="name") <- "EE" edgeData(g, from = from, to = to , attr = "name") <- paste(from, to , sep= "") res <- removeNode(c("x","b"), g) current <- nodeData(res, attr = "name") target <- as.list(structure( c("a", "c", "d", "y"), names = c("a", "c", "d", "y"))) checkEquals(target, current) current <- edgeData(res, attr = "name") target <- as.list(structure( "dy", names = paste("d", "y", sep = "|"))) checkEquals(current, target) res <- removeNode(c("x", "a"), g) current <- edgeData(res, attr = "name") target <- as.list(structure( c("bc", "dy"), names = paste(c("b", "d"), c("c","y"), sep = "|"))) checkEquals(target, current) } test_edgeDataUndirectedGraph <- function() { df <- data.frame(from=c("a", "a", "c"), to=c("b", "c", "d"), weight=rep(1, 3), stringsAsFactors=FALSE) g <- graphBAM(df, edgemode="undirected") edgeDataDefaults(g, attr="EDA") <- 0 edgeData(g, from="a", to="b", attr="EDA") <- 1 edgeData(g, from="a", to="c", attr="EDA") <- 2 edgeData(g, attr="EDA", from="a") # for edges where "a" is the source node, and to unspecified checkEquals(edgeData(g, attr="EDA", from="a")[["a|b"]], 1) checkEquals(edgeData(g, attr="EDA", from="a")[["a|c"]], 2) # specify single values for from and to checkEquals(edgeData(g, attr="EDA", from="a", to="b")[[1]], 1) checkEquals(edgeData(g, attr="EDA", from="a", to="c")[[1]], 2) # multiple target nodes x <- edgeData(g, from="a", to=c("b","c"), attr="EDA") checkEquals(length(x), 2) checkEquals(sort(names(x)), c("a|b", "a|c")) checkEquals(as.numeric(edgeData(g, from="a", to=c("b","c"), attr="EDA")), c(1,2)) checkException(edgeData(g, from="a", to="bogus", attr="EDA"), silent=TRUE) checkException(edgeData(g, from=c("a", "c"), to=c("bogus", "bagus"), attr="EDA"), silent=TRUE) } test_edgeMatrix <- function() { g <- graphBAM(data.frame(from="1", to="2", weight=1, stringsAsFactors = TRUE)) mtx <- edgeMatrix(g, duplicates=FALSE) checkEquals(dim(mtx), c(2,1)) checkEquals(rownames(mtx), c("from", "to")) checkEquals(as.numeric(mtx), c(1, 2)) mtx.dup <- edgeMatrix(g, duplicates=TRUE) checkEquals(dim(mtx.dup), c(2,2)) checkEquals(rownames(mtx.dup), c("from", "to")) checkEquals(as.numeric(mtx.dup), c(1, 2, 2, 1)) } test_removeEdge_from_undirectedGraph <- function() { g <- graphBAM(data.frame(from="A", to="B", weight=1, stringsAsFactors = TRUE)) g <- removeEdge(from="A", to="B", g=g) checkEquals(numEdges(g), 0) g <- graphBAM(data.frame(from="A", to="B", weight=1, stringsAsFactors = TRUE)) g <- removeEdge(from="B", to="A", g=g) checkEquals(numEdges(g), 0) } test_AM2BAM <- function(){ # test the fix for a nov 2014 bug, in which MultiGraph::.makeMDEdgeSet # fails to make edge_sets in the graphBAM constructor when only 1 edge # exists. fix is at line 66 in MultiGraph.R: "drop=FALSE" added to the subset operation mtx <- matrix(c(0,1,0,0), ncol=2, byrow=TRUE, dimnames=list(c("A", "B"), c("A", "B"))) # first create and check a simple (non-binary) adjacency matrix graph g.am <- graphAM(mtx, edgemode="directed") checkEquals(nodes(g.am), c("A", "B")) checkEquals(edgemode(g.am), "directed") checkEquals(edgeNames(g.am), "A~B") # now convert to BAM g.bam <- as(g.am, "graphBAM") checkEquals(nodes(g.bam), c("A", "B")) checkEquals(edgemode(g.bam), "directed") checkEquals(edgeNames(g.bam), "A~B") } test_isAdjacent <- function() { am <- adjacencyMatrix # for shorthand g <- graphBAM(data.frame(from="B", to="C", weight=1, stringsAsFactors = TRUE), edgemode="undirected") checkEquals(rownames(am(g)), c("B", "C")) checkEquals(colnames(am(g)), c("B", "C")) checkEquals(am(g)["B","C"], 1) checkEquals(am(g)["C","B"], 1) checkTrue(isAdjacent(g, "B", "C")) checkTrue(isAdjacent(g, "C", "B")) checkEquals(as.numeric(edgeMatrix(g)), c(1,2)) # reciprocal edges not stored # add a node, then an edge to the undirected graph g g <- addNode("A", g) checkEquals(nodes(g), c("A", "B", "C")) # just one edge checkEquals(sum(am(g)), 2) checkEquals(am(g)["B", "C"], 1) checkEquals(am(g)["C", "B"], 1) checkTrue(isAdjacent(g, "B", "C")) checkTrue(isAdjacent(g, "C", "B")) g <- addEdge(from="C", to="A", graph=g) checkEquals(sum(am(g)), 4) checkEquals(am(g)["B", "C"], 1) checkEquals(am(g)["C", "B"], 1) checkEquals(am(g)["A", "C"], 1) checkEquals(am(g)["C", "A"], 1) # robert's bug: both of these fail though direct inspection # of either edgeMatrix or adjacencyMatrix show correct edges checkTrue(isAdjacent(g, "A", "C")) checkTrue(isAdjacent(g, "C", "A")) # now verify non-reciprocity of B-C edge in a directed graph gd <- graphBAM(data.frame(from="B", to="C", weight=1, stringsAsFactors = TRUE), edgemode="directed") checkEquals(rownames(am(gd)), c("B", "C")) checkEquals(colnames(am(gd)), c("B", "C")) checkEquals(am(gd)["B","C"], 1) checkTrue(isAdjacent(gd, "B", "C")) checkTrue(!isAdjacent(gd, "C", "B")) # add a node, then an edge to the directed graph gd gd <- addNode("A", gd) checkEquals(nodes(gd), c("A", "B", "C")) # just one edge checkEquals(sum(am(gd)), 1) checkEquals(am(gd)["B", "C"], 1) checkTrue(isAdjacent(gd, "B", "C")) gd <- addEdge(from="C", to="A", graph=gd) checkTrue(isAdjacent(gd, "C", "A")) } # test_isAdjacent # incomplete draft test supplied by Robert Castello (November 2014) test_robertCastelos_addEdge_edgeData_bug <- function() { am <- adjacencyMatrix # for shorthand #Sys.setlocale("LC_ALL", "C") #checkEquals(Sys.getlocale(), "C") g <- graphBAM(data.frame(from="B", to="C", weight=1, stringsAsFactors = TRUE)) checkEquals(rownames(am(g)), c("B", "C")) checkEquals(colnames(am(g)), c("B", "C")) checkEquals(am(g)["B","C"], 1) edgeDataDefaults(g, "x") <- NA_real_ g <- addNode("A", g) checkEquals(rownames(am(g)), c("A", "B", "C")) checkEquals(colnames(am(g)), c("A", "B", "C")) g <- addEdge(from="C", to="A", graph=g) checkEquals(am(g)["C", "A"], 1) ## this one works fine edgeData(g, from="A", to="C", "x") <- 10 ## however, this one breaks the code: no longer! edgeData(g, from="C", to="A", "x") <- 10 # ensures that no error was found in the above operations checkTrue(TRUE) } # Sys.setlocale("LC_ALL", "C") # checkEquals(Sys.getlocale(), "C") # g <- graphBAM(data.frame(from="B", to="C", weight=1)) # edgeDataDefaults(g, "x") <- NA_real_ # g <- addNode("A", g) # g <- addEdge(from="C", to="A", graph=g) # # ## this one works fine # edgeData(g, from="A", to="C", "x") <- 10 # # ## however, this one breaks the code # edgeData(g, from="C", to="A", "x") <- 10 graph/inst/unitTests/gxl_test.R0000644000175000017500000000350414136046755016455 0ustar nileshnileshsimpleWithAttributes <- system.file("GXL/attributesExample.gxl", package="graph") if (nchar(simpleWithAttributes) == 0) stop("bad gxl path") testGxlNodes <- function() { con <- file(simpleWithAttributes) tryCatch({ g <- fromGXL(con) eNodes <- c("p", "q", "v", "w") checkEquals(eNodes, nodes(g)) }, finally=close(con)) } testGxlEdges <- function() { con <- file(simpleWithAttributes) tryCatch({ g <- fromGXL(con) eEdges <- list(p=c("v", "q"), q="w", v=character(0), w=character(0)) checkEquals(eEdges, edges(g)) }, finally=close(con)) } testGxlNodeAttrs <- function() { con <- file(simpleWithAttributes) tryCatch({ g <- fromGXL(con) checkEquals(316, nodeData(g, "w", "line")[[1]]) checkEquals(225, nodeData(g, "v", "line")[[1]]) checkEquals("main.c", nodeData(g, "p", "file")[[1]]) checkEquals(555, nodeData(g, "p", "code")[[1]]) checkEquals(1.234, nodeData(g, "p", "rate")[[1]]) checkEquals(TRUE, nodeData(g, "p", "pass")[[1]]) checkEquals(FALSE, nodeData(g, "p", "fail")[[1]]) checkTrue(is.na(nodeData(g, "p", "line")[[1]])) }, finally=close(con)) } testNodeEdgeOrderDoesNotMatter <- function() { gxlFile <- system.file("GXL/outOfOrderExample.gxl", package="graph") con <- file(gxlFile) tryCatch({ g <- fromGXL(con) checkEquals(c("p", "v", "q", "w"), nodes(g)) }, finally=close(con)) } testUndirectedReading <- function() { gxlFileGz <- system.file("GXL/graphExample-02.gxl.gz", package="graph") con <- gzfile(gxlFileGz, open="rb") tryCatch({ g <- fromGXL(con) checkEquals(10, numEdges(g)) checkEquals(9, numNodes(g)) }, finally=close(con)) } graph/inst/unitTests/graphNEL_test.R0000644000175000017500000003252114136046755017324 0ustar nileshnilesh ##.setUp <- function() RNGkind("default", "default") simpleGraphNEL <- function() { V <- letters[1:4] edL <- vector("list", length=4) names(edL) <- V edL[["a"]] <- list(edges=c(3, 4), weights=c(.13, .14)) edL[["b"]] <- list(edges=c(3, 4), weights=c(.23, .24)) edL[["c"]] <- list(edges=c(1, 2, 4), weights=c(.13, .23, .34)) edL[["d"]] <- list(edges=c(1, 2, 3), weights=c(.14, .24, .34)) gR <- graphNEL(nodes=V, edgeL=edL) gR } simpleDirectedGraphNEL <- function() { set.seed(123) V <- letters[1:4] edL <- vector("list", length=4) names(edL) <- V edL[["a"]] <- list(edges=c(3, 4), weights=c(.13, .14)) edL[["b"]] <- list(edges=c(3), weights=.23) edL[["c"]] <- list(edges=numeric(0), weights=numeric(0)) edL[["d"]] <- list(edges=c(2, 3), weights=c(.42, .43)) gR <- graphNEL(nodes=V, edgeL=edL, edgemode="directed") gR } testConstructorFunction <- function() { nodes <- LETTERS[1:4] edgeL <- list(A=c("B", "C"), B="C", C="D") ## no-argument constructor target <- new("graphNEL") checkIdentical(target, graphNEL()) ## node / edgeList constructor target <- new("graphNEL", nodes=nodes, edgeL=edgeL, edgemode="directed") checkIdentical(target, graphNEL(nodes, edgeL, "directed")) ## edgemode default == "undirected" edgeL2 <- list(A = c("B", "C"), B = c("A", "C"), C = c("A", "B", "D"), D = "C") target <- new("graphNEL", nodes=nodes, edgeL=edgeL2) checkIdentical(target, graphNEL(nodes, edgeL2, "undirected")) } testCreateBadNodeNames <- function() { badNodeName <- paste("foo", graph:::EDGE_KEY_SEP, "bar", sep="") checkException(graphNEL(nodes=badNodeName), silent=TRUE) checkException(graphNEL(nodes=c(NA, "b")), silent=TRUE) checkException(graphNEL(nodes=c("a", "")), silent=TRUE) } testIsAdjacent <- function() { g1 <- simpleGraphNEL() checkEquals(FALSE, isAdjacent(g1, "a", "b")) checkEquals(TRUE, isAdjacent(g1, "a", "c")) expect <- c(FALSE, TRUE, TRUE) got <- isAdjacent(g1, c("a", "a", "a"), c("b", "c", "d")) checkEquals(expect, got) } testNumEdges <- function() { mat <- matrix(c(1, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 0, 0, 0), ncol=4) rownames(mat) <- letters[1:4] colnames(mat) <- letters[1:4] g <- as(mat, "graphNEL") checkEquals(4, numEdges(g)) } testInEdges <- function() { g <- simpleDirectedGraphNEL() expectedInEdges <- list(a=character(0), b="d", c=c("a", "b", "d"), d="a") checkEquals(expectedInEdges, inEdges(g)) checkEquals(expectedInEdges, inEdges(object=g)) n <- c("a", "d") checkEquals(expectedInEdges[n], inEdges(n, g)) ## verify unknown node behavior ans <- tryCatch(inEdges("not-a-node", g), error = function(e) e) checkEquals("not a node: 'not-a-node'", conditionMessage(ans)) } testEmptyGraph <- function() { g <- graphNEL() checkEquals(0, numEdges(g)) checkEquals(0, numNodes(g)) } testCreateGraphNoEdges <- function() { g <- graphNEL(nodes=c("a", "b")) checkEquals(0, numEdges(g)) checkEquals(2, numNodes(g)) g <- graphNEL(nodes=c("a", "b"), edgeL=list()) checkEquals(0, numEdges(g)) checkEquals(2, numNodes(g)) checkEquals(2, length(edges(g))) checkEquals(nodes(g), names(edges(g))) checkEquals(0, sum(sapply(edges(g), length))) } testConstructor <- function() { g <- simpleGraphNEL() g2 <- graphNEL(nodes=nodes(g), edgeL=edges(g)) checkEquals(nodes(g), nodes(g2)) checkEquals(edges(g), edges(g2)) ## We also support the more complicated list structure for describing graph ## edges. g2 <- graphNEL(nodes=nodes(g), edgeL=g@edgeL) checkEquals(nodes(g), nodes(g2)) checkEquals(edges(g), edges(g2)) } testNullHandlingInEdgeL <- function() { g <- simpleDirectedGraphNEL() eL <- g@edgeL eL <- c(eL[c("a", "b", "c")], list(d=NULL)) g2 <- graphNEL(nodes(g), eL, "directed") checkTrue(all(sapply(g2@edgeL, function(x) !is.null(x)))) } testCaptureWeightsWithEdgeLUndirected <- function() { g <- simpleGraphNEL() expect <- as.list(c(.13, .14)) names(expect) <- c("a|c", "a|d") checkEquals(expect, edgeData(g, from="a", attr="weight")) } testCaptureWeightsWithEdgeLDirected <- function() { g <- simpleDirectedGraphNEL() expect <- as.list(c(.13, .14)) names(expect) <- c("a|c", "a|d") checkEquals(expect, edgeData(g, from="a", attr="weight")) } testAddNode <- function() { g1 <- simpleGraphNEL() newNodes <- c("r", "s", "a", "b") checkException(addNode(newNodes, g1), silent=TRUE) newNodes <- c("r", "s") expect <- c(nodes(g1), newNodes) g1 <- addNode(newNodes, g1) checkEquals(expect, nodes(g1)) } testAddNodeWithEdges <- function() { g1 <- simpleGraphNEL() newNodes <- c("r", "s", "t") newEdges <- list(r=c("a", "s"), s="b", t=character(0)) g2 <- addNode(newNodes, g1, newEdges) checkEquals(c(nodes(g1), newNodes), nodes(g2)) expect <- list(r=c("a", "s")) checkEquals(expect, edges(g2)["r"]) expectEdges <- edges(g1) expectEdges[["a"]] <- c(expectEdges[["a"]], "r") expectEdges[["b"]] <- c(expectEdges[["b"]], "s") expectEdges[["r"]] <- c("a", "s") expectEdges[["s"]] <- c("r", "b") expectEdges[["t"]] <- character(0) checkEquals(expectEdges, edges(g2)) } testAddNodeWithEdgesAndWeights <- function() { g1 <- simpleGraphNEL() newNodes <- c("r", "s", "t") newEdges <- list(r=c(a=11, s=22), s=c(b=33), t=numeric(0)) g2 <- addNode(newNodes, g1, newEdges) checkEquals(c(nodes(g1), newNodes), nodes(g2)) expect <- list(r=c("a", "s")) checkEquals(expect, edges(g2)["r"]) expectEdges <- edges(g1) expectEdges[["a"]] <- c(expectEdges[["a"]], "r") expectEdges[["b"]] <- c(expectEdges[["b"]], "s") expectEdges[["r"]] <- c("a", "s") expectEdges[["s"]] <- c("r", "b") expectEdges[["t"]] <- character(0) checkEquals(expectEdges, edges(g2)) } testAddNodeBadNodeName <- function() { g1 <- simpleGraphNEL() badNodeName <- paste("foo", graph:::EDGE_KEY_SEP, "bar", sep="") checkException(addNode(badNodeName, g1), silent=TRUE) } testSubGraphNoEdges <- function() { g1 <- simpleGraphNEL() g1 <- removeEdge("a", c("c", "d"), g1) g2 <- subGraph("a", g1) ## g2 has no edges checkEquals(0, numEdges(g2)) checkEquals(1, numNodes(g2)) } testSubGraphNoEdgesDirected <- function() { g1 <- simpleDirectedGraphNEL() g1 <- removeEdge("a", c("c", "d"), g1) g2 <- subGraph("a", g1) ## g2 has no edges checkEquals(0, numEdges(g2)) checkEquals(1, numNodes(g2)) } testSubGraphAttributes <- function() { g1 <- simpleDirectedGraphNEL() nodeDataDefaults(g1) <- list(w=NA, n="") nodeData(g1, n=c("a", "b"), attr="w") <- c(1, 2) nodeData(g1, n=c("a", "b"), attr="n") <- c("A", "B") edgeDataDefaults(g1) <- list(x=NA) edgeData(g1, from="a", to="d", attr="x") <- 6 edgeData(g1, from="a", to="c", attr="x") <- 7 g2 <- subGraph(c("a", "d"), g1) checkEquals("a", names(g2@nodeData)) g3 <- subGraph(c("a", "b", "c"), g1) checkEquals(c("a|c", "b|c"), names(g3@edgeData)) } testRemoveEdgeUndirected <- function() { g <- simpleGraphNEL() g1 <- removeEdge("a", c("c", "d"), g) checkEquals(3, numEdges(g1)) eD <- edges(g1) checkEquals(character(0), eD$a) checkEquals(c("c", "d"), eD$b) g2 <- removeEdge(c("c", "d"), "a", g) checkEquals(3, numEdges(g2)) eD <- edges(g2) checkEquals(character(0), eD$a) checkEquals(c("c", "d"), eD$b) } testRemoveEdgeDirected <- function() { g1 <- simpleDirectedGraphNEL() f <- c("a", "a") t <- c("c", "d") g2 <- removeEdge(from=f, to=t, g1) checkEquals(3, numEdges(g2)) checkTrue(!length(edges(g2)[["a"]])) } testRemoveEdgeLarge <- function() { ## This test is from Denise Scholtens set.seed(678) N <- 500 numEdges <- 2500 nodes <- paste("n", 1:500, sep="") g <- randomEGraph(nodes, edges=numEdges) edgemode(g) <- "directed" checkEquals(numEdges*2, numEdges(g)) edges <- sample(edges(g)) from <- rep(names(edges), each = 2) to <- unlist(lapply(edges, sample, 2), use.names = FALSE) g1 <- removeEdge(from, to, g) checkEquals(numEdges*2 - length(from), numEdges(g1)) } testRemoveEdgeLarge2 <- function() { ## This test is from a bug discovered by Dan Bebber From <- c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 5, 5, 8, 8, 8, 8, 8, 11, 11, 12, 12, 12, 14, 14, 16, 16, 20, 20, 23, 23, 24, 24, 25, 25, 29, 29, 32, 32, 32, 32, 38, 38, 41, 41, 41, 43, 43, 54, 54, 59, 59, 60, 68, 68, 69, 72, 82, 83, 88, 88, 88, 88, 89, 89, 90, 90, 96, 97, 98, 98, 98) To <- c(2, 5, 8, 11, 12, 14, 16, 20, 23, 37, 38, 54, 57, 68, 72, 81, 86, 87, 97, 88, 100, 32, 102, 38, 41, 49, 51, 53, 58, 59, 60, 63, 67, 71, 72, 75, 76, 84, 85, 24, 29, 25, 28, 26, 27, 30, 31, 33, 34, 35, 36, 40, 41, 42, 43, 47, 44, 45, 55, 56, 60, 62, 61, 70, 71, 71, 73, 84, 84, 89, 90, 93, 94, 97, 141, 95, 141, 141, 98, 99, 141, 158) FT <- matrix(c(From, To), ncol=2) #create a 'from-to' matrix g <- ftM2graphNEL(FT, edgemode="undirected") gr <- removeEdge(from=as.character(From[1:2]), to=as.character(To[1:2]), g) checkEquals(numEdges(g) - 2, numEdges(gr)) gr <- removeEdge(from=as.character(From[1:20]), to=as.character(To[1:20]), g) checkEquals(numEdges(g) - 20, numEdges(gr)) } test_eWV <- function() { V <- LETTERS[1:4] gR <- graphNEL(nodes=V) gX <- addEdge("A", "C", gR, 0.2) ans <- eWV(gX, edgeMatrix(gX), useNNames = TRUE) checkEquals(c("A--C"=0.2), ans) } testEdgeWeightsNoEdges <- function() { g <- graphNEL(nodes=letters[1:6]) expect <- lapply(edges(g), as.numeric) checkEquals(expect, edgeWeights(g)) } testRemoveNode1 <- function() { ## using the example from the removeNode help page V <- LETTERS[1:4] edL2 <- vector("list", length=4) names(edL2) <- V for(i in 1:4) edL2[[i]] <- list(edges=c(2,1,2,1)[i], weights=sqrt(i)) gR2 <- graphNEL(nodes=V, edgeL=edL2, edgemode="directed") gX <- removeNode("C", gR2) checkEquals(c("A", "B", "D"), nodes(gX)) gY <- removeNode(c("A","D"), gX) checkEquals("B", nodes(gY)) gZ <- removeNode(c("A","C","D"), gR2) checkEquals("B", nodes(gZ)) ## XXX: using direct slot access to verify that edge attributes ## have been completely removed. checkTrue(length(gZ@edgeData@data) == 0) } testRemoveNode2 <- function() { g <- simpleDirectedGraphNEL() nds <- nodes(g) for (n in nds) { g2 <- removeNode(n, g) checkEquals(nds[nds != n], nodes(g2)) } } test_ugraph <- function() { g <- simpleDirectedGraphNEL() ug <- ugraph(g) eg <- simpleGraphNEL() checkTrue(isDirected(g)) checkTrue(!isDirected(ug)) checkEquals(nodes(g), nodes(ug)) checkEquals(nodes(eg), nodes(ug)) ## verify edges eGot <- edges(ug)[nodes(g)] eExp <- edges(eg)[nodes(g)] for (n in nodes(g)) { checkTrue(setequal(eExp[[n]], eGot[[n]])) } } test_rename_nodes_edgeWeights <- function() { g <- simpleGraphNEL() ew <- edgeWeights(g) ew <- lapply(ew, function(x) { names(x) <- toupper(names(x)) x }) names(ew) <- toupper(names(ew)) nodes(g) <- LETTERS[1:4] checkEquals(LETTERS[1:4], nodes(g)) checkEquals(ew, edgeWeights(g)) } test_rename_nodes_nodeData <- function() { g <- simpleGraphNEL() nodeDataDefaults(g) <- list(type=NA) nodeData(g, n="a", attr="type") <- "the first one" nodeData(g, n="d", attr="type") <- "the last one" ndDef <- nodeDataDefaults(g) nd <- nodeData(g, attr="type") names(nd) <- toupper(names(nd)) nodes(g) <- toupper(nodes(g)) checkEquals(nd, nodeData(g, attr="type")) } test_subgraph_attrs <- function() { x <- graphNEL(nodes=c("a", "b"), edgeL=list(a="b", b="b"), edgemode="directed") defs <- list(tag="NONE") nodeDataDefaults(x) <- defs edgeDataDefaults(x) <- defs nodeData(x, n="a", attr="tag") <- "zoo" edgeData(x, "a", "b", attr="tag") <- "yes" gg <- subGraph(c("a", "b"), x) checkEquals(defs, nodeDataDefaults(gg)) checkEquals(defs, edgeDataDefaults(gg)) checkEquals("zoo", nodeData(gg, "a", attr="tag")[[1]]) checkEquals("yes", edgeData(gg, "a", "b", attr="tag")[[1]]) } test_ftM2_with_self_edges <- function() { ft <- cbind(c(1:5,1,5),c(1:5,3,2)) W <- c(1:5,7,9) ## this failed till 2008-06-26: gr <- ftM2graphNEL(ft, W, edgemode="undirected") m <- as(gr, "matrix") g2 <- as(m, "graphNEL") m2 <- as(g2, "matrix") checkEquals(m2, m) checkEquals(which(m2 != 0), c(1,3,7,10,11,13,19,22,25)) } test_coerce_matrix_round_trip <- function() { V <- LETTERS[1:4] g <- graphNEL(nodes=V, edgemode="directed") g <- addEdge(V[1+0],V[1+1],g, 3) g <- addEdge(V[1+0],V[2+1],g, 1.5) g <- addEdge(V[1+0],V[3+1],g, 1.8) g <- addEdge(V[1+1],V[2+1],g, 4.3) g <- addEdge(V[1+2],V[3+1],g, 2.2) mat0 <- matrix(c(0, 0, 0, 0, 3, 0, 0, 0, 1.5, 4.3, 0, 0, 1.8, 0, 2.2, 0), ncol=4, dimnames = list(LETTERS[1:4], LETTERS[1:4])) checkEquals(mat0, as(g, "matrix")) checkEquals(mat0, as(as(mat0, "graphNEL"), "matrix")) } graph/inst/unitTests/degree_test.R0000644000175000017500000000114714136046755017117 0ustar nileshnileshlibrary("graph") data(graphExamples) data(apopGraph) test_degree_undirected <- function() { g <- graphExamples[[1]] want <- as.integer(c(5, 5, 1, 5, 5, 5, 0, 6, 0, 0)) names(want) <- nodes(g) checkEquals(want, degree(g)) gam <- as(g, "graphAM") checkEquals(want, degree(g)) } test_degree_directed <- function() { want_in <- c(TRF1=1L, "NF-kB"=4L, CASP2=2L, Daxx=0L) want_out <- c(TRF1=1L, "NF-kB"=1L, CASP2=0L, Daxx=1L) got <- degree(apopGraph, c("TRF1", "NF-kB", "CASP2", "Daxx")) checkEquals(want_in, got[["inDegree"]]) checkEquals(want_out, got[["outDegree"]]) } graph/inst/unitTests/setbit_test.R0000644000175000017500000000636514136046755017165 0ustar nileshnilesh.testbit <- graph:::testbit setbitv <- graph:::setbitv setbit <- graph:::setbit bitToMat <- graph:::bitToMat makebits <- graph:::makebits test_setbitv <- function() { len <- 5L * 8L xx <- makebits(len) for (i in seq_len(len)) { checkEquals(FALSE, .testbit(xx, i)) xx <- setbitv(xx, i, FALSE) checkEquals(FALSE, .testbit(xx, i)) } xx <- makebits(len) for (i in seq_len(len)) { checkEquals(FALSE, .testbit(xx, i)) xx <- setbitv(xx, i, TRUE) checkEquals(TRUE, .testbit(xx, i), msg=paste("iter", i)) } for (i in seq_len(len)) checkEquals(TRUE, .testbit(xx, i)) for (i in seq_len(len)) xx <- setbitv(xx, i, FALSE) for (i in seq_len(len)) checkEquals(FALSE, .testbit(xx, i)) } test_setbitv_vectorized <- function() { len <- 3L * 8L xx <- makebits(len) xxall <- setbitv(xx, 1:10, rep(TRUE, 10)) checkTrue(all(.testbit(xxall, 1:10))) checkTrue(!any(.testbit(xxall, 11:len))) } test_setbit_basics <- function() { xx <- makebits(40L) tf <- function(n) rawToBits(setbit(xx, n)[1]) got <- as.logical(do.call(rbind, lapply(1:8, tf))) dim(got) <- c(8, 8) want <- matrix(FALSE, nrow=8, ncol=8) diag(want) <- TRUE checkEquals(want, got) tf <- function(n) rawToBits(setbit(xx, n)[2]) got <- as.logical(do.call(rbind, lapply(9:16, tf))) dim(got) <- c(8, 8) want <- matrix(FALSE, nrow=8, ncol=8) diag(want) <- TRUE checkEquals(want, got) x2 <- setbit(xx, 38) for (i in 1:4) checkTrue(!as.logical(x2[i])) checkTrue(as.logical(x2[5])) } test_testbit <- function() { xx <- makebits(40) for (i in 1:(5 * 8)) { checkTrue(!.testbit(xx, i)) } checkTrue(!any(.testbit(xx, 1:40))) xx <- as.raw(rep(255L, 5)) for (i in 1:(5 * 8)) { checkTrue(.testbit(xx, i), i) } checkTrue(all(.testbit(xx, 1:40))) xx <- setbit(as.raw(5), 23) checkTrue(.testbit(xx, 23)) checkEquals(c(TRUE, TRUE), .testbit(xx, c(23, 23))) checkEquals(c(FALSE, TRUE), .testbit(xx, c(21, 23))) checkEquals(c(TRUE, FALSE), .testbit(xx, c(23, 24))) } rand_bitarray_matrix <- function(nrow, nset) { bv <- makebits(nrow^2, bitdim=c(nrow, nrow)) idx <- sample(1:(nrow^2), nset) setbitv(bv, idx, rep(1L, length(idx))) } test_bitToMat <- function() { make_mat <- function(nrow) { matrix(sample(c(0L, 1L), nrow^2, replace = TRUE), nrow = nrow) } do_test <- function(nrow) { m <- make_mat(nrow) bv <- makebits(nrow^2, bitdim=c(nrow, nrow)) bv <- setbitv(bv, which(m == 1L), rep(1L, sum(m))) checkEquals(m, bitToMat(bv)) } sizes <- c(1, 2, 5, 13, 26) reps <- c(2, 3, 25, 25, 25) for (i in seq_along(sizes)) { size <- sizes[i] for (j in seq_len(reps[i])) do_test(size) } } test_bitarray_transpose <- function() { nreps <- 25L sizes <- as.integer(c(1, 2, 4, 5, 6, 7, 23, 24)) for (size in sizes) { for (i in seq_len(nreps)) { v0 <- rand_bitarray_matrix(size, ceiling((size^2) %/% 2)) m0 <- bitToMat(v0) want <- t(m0) vt <- .Call(graph:::graph_bitarray_transpose, v0) mt <- bitToMat(vt) checkEquals(want, mt) } } } graph/inst/Scripts/0000755000175000017500000000000014136046755014124 5ustar nileshnileshgraph/inst/Scripts/pTreetest.R0000644000175000017500000000046014136046755016226 0ustar nileshnilesh library(methods) .initpTreeClass(globalenv()) pT1 <- new("pTree") npT<-pTreeInsert(pT1, "a", 10) objs <- letters[1:12] vals<-c(2, 14, 7, 21, 16, 18, 11, 1, 25, 3, 8, 5) for( i in 1:12) npT <- pTreeInsert(npT, objs[i], vals[i]) unlist(npT@values) xx<-pTreeDelete(npT, "d") graph/inst/Scripts/testintersection.R0000644000175000017500000000303214136046755017653 0ustar nileshnilesh## ------------------------------------------------------------ ## (wh) 05 Feb 2005 ## Test and benchmark the three different implementations of ## graph intersection ## Results: for sparse graphs (e.g. nodes=edges=2000), intersection3 ## is fastest; for dense graphs (e.g. nodes=200, edges=10000), ## intersection2 is faster. With the given parameters, I obtained: ## ## Sparse ## t1 27.74 0.23 58.75 0 0 ## t2 27.35 0.11 61.68 0 0 ## t3 5.03 0.02 10.98 0 0 ## ## Dense: ## t1 2.61 0.00 2.77 0 0 ## t2 1.13 0.01 1.57 0 0 ## t3 6.28 0.01 7.15 0 0 library("graph") options(error=recover) nodes = 2000; edges = 2000 ## sparse ## nodes = 200; edges = 10000 ## dense V = paste(formatC(1:nodes, width=5, flag="0")) B = 5 set.seed(123) g1 <-lapply(1:B, function(i) randomEGraph(V=V, edges=edges)) g2 <-lapply(1:B, function(i) randomEGraph(V=V, edges=edges)) t3 <- system.time( i3 <- mapply(intersection3, g1, g2) ) t1 <- system.time( i1 <- mapply(intersection, g1, g2) ) t2 <- system.time( i2 <- mapply(intersection2, g1, g2) ) identical.graphs = function(g1, g2) { if(!identical(nodes(g1), nodes(g2))) stop("Baeh 1") e1 <- edges(g1) e2 <- edges(g2) s = mapply(function(x,y) all(sort(x)==sort(y)), e1, e2) if(!all(s)) stop("Baeh 2") return(TRUE) } cat("system.time:\n") print(rbind(t1,t2,t3)) ## Check whether all are identical cat("Now checking:\n") for(i in seq(along=i1)) { stopifnot(identical.graphs(i1[[i]], i2[[i]])) stopifnot(identical.graphs(i1[[i]], i3[[i]])) } graph/inst/Scripts/multigraph.R0000644000175000017500000000100414136046755016416 0ustar nileshnilesh set.seed(123) V <- LETTERS[1:4] edL <- vector("list", length=4) names(edL) <- V for(i in 1:4) edL[[i]] <- list(edges=5-i, weights=runif(1)) e1 = new("edgeSetNEL", edgemode="undirected", edgeL = edL) x = matrix(rnorm(12), nrow=4, dimnames=list(V, NULL)) d1 = as.matrix(dist(x)) e2 = new("edgeSetAM", edgemode="undirected", adjMat = ifelse(d1>1, 1, 0)) mg1 = new("multiGraph", nodes = V, edgeL = list(e1, e2)) mg1 edges(mg1) isDirected(mg1) numEdges(mg1) graph/inst/Scripts/distGraph.R0000644000175000017500000000126314136046755016176 0ustar nileshnilesh ##some code for distGraphs ## a concrete example: library(Biobase) library(mva) setwd("c:/cygwin/home/rgentlem/Software/graph/R") source("clustergraph.R") data(eset) d1 <- dist(exprs(eset)) length(d1) ##should be 124750 ##500*499/2 ## 124750 ## we could take deciles and deciles <- quantile(unclass(d1), probs=seq(0.1,0.9,0.1)) dG <- new("distGraph", Dist=d1) dG2 <- threshold(dG, deciles[8]) dG3 <- threshold(dG, deciles[4]) xx<- d1[1:10, c(3,5,11)] ad1 <- adj(dG3, 10) ac1 <- acc(dG3, 10) cc <- connComp(dG3) dG4 <- threshold(dG, deciles[1]/2.1) cc4 <- connComp(dG4) J<- sapply(cc4, function(x) length(x)) table(J) graph/inst/Scripts/Graph.R0000644000175000017500000000577714136046755015330 0ustar nileshnilesh##some new things library(methods) library(graph) library(GO) library(hgu95a) xx <- ls(env = hgu95aGO) set.seed(1234) myGenes <- sample(xx, 100) mG <- mget(myGenes, env=hgu95aGO) makeGoGraph <- function(x) { library(GO) newNodes <- get(x, env=hgu95aGO) if( is.na(x) ) return(NULL) oldEdges <- vector("list", length=0) oldNodes <- vector("character", length=0) done <- FALSE while( !done ) { newNodes <- newNodes[!(newNodes %in% oldNodes)] if( length(newNodes) == 0 ) done <- TRUE else { oldNodes <- c(oldNodes, newNodes) numE <- length(newNodes) nedges <- vector("list", length=numE) names(nedges) <- newNodes nedges <- mget(newNodes, env=GOmolecularfunction) nedges <- nedges[!is.na(nedges)] oldEdges <- c(oldEdges, nedges) newNodes <- sort(unique(unlist(nedges))) } } rE <- vector("list", length=length(oldNodes)) names(rE) <- oldNodes rE[names(oldEdges)] <- oldEdges return(list(nodes=oldNodes, edges=rE)) } Gmf1 <- makeGoGraph(myGenes[1]) ##old examples library(graph) data(pmedu95aAffy) pmG <- pmedu95aAffy edgeL <- lapply(pmG@edges, function(x) list(edges=x)) pmG <- graphNEL(nodes=pmG@nodes, edgeL=edgeL) xx1<-acc(pmG, "1025_g_at") xx2<-acc2(pmG, "1025_g_at") set.seed(12345) myNodes <- sample(nodes(pmG), 500) pmS <- makeSubGraph(pmG, myNodes) xx<- acc(pmS, "35990_at") xy <- dfs(pmS) zz <- acc(pmS, "35990_at") zz2 <- acc(pmS, "35990_at") pm2 <- makeSubGraph(pmG, myNodes[1:100]) pm3<-isect(pm2, pmS) ##Sept 27 -- trying to test some graph code #library(methods) #setwd("c:\\cygwin/home/rgentlem\\Software\\graph\\R") #source("graph.R") #.initGraph(globalenv()) x<-1:100 rw <- rep("a", 100) for(i in 1:100) rw[i] <- paste(sample(letters, 10, replace=TRUE), sep="", collapse="") set.seed(121) ##this is a directed graph -- the nodes are one way nodes y<- vector("list", length=100) for(i in 1:100) { nnodes<- floor(runif(1)*20) y[[i]] <- list(edges=sample(x, nnodes), weights=runif(nnodes)) } sapply(y, function(x) length(x$weights)) names(y) <- rw g1 <- graphNEL(nodes=rw, edgeL=y) z<-lapply(y, function(x) {x$weights<-NULL; x}) g2 <- graphNEL(nodes=rw, edgeL=z) #get the adjcency list for node number 10 vv<-adj(g1, 10) #get the accessibility list for node number 10 vw <- acc(g1, 2) ##for an undirected graph we generate a node list for each node set.seed(333) y2<- vector("list", length=100) for(i in 1:100) y2[[i]] <- list(edges=numeric(0), weights=numeric(0)) for(i in 1:100) { nnodes<- floor(runif(1)*3) jj<-sample(x, nnodes) for (j in jj) { wt <- 18*runif(1) y2[[i]]$edges <- c(y2[[i]]$edges, j) y2[[i]]$weights <- c(y2[[i]]$weights, wt) y2[[j]]$edges <- c(y2[[j]]$edges, i) y2[[j]]$weights <- c(y2[[j]]$weights, wt) } } g3 <- graphNEL(nodes=rw, edgeL=y2) b1 <- isect(g1, g3) sN1 <- sample(1:100, 20) g4 <- subGraph(g1, sN1) E1 <- edgeL(g3) E2 <- edgeL(g3, sN1) graph/inst/GXL/0000755000175000017500000000000014136046755013127 5ustar nileshnileshgraph/inst/GXL/graphExample-03.gxl.gz0000644000175000017500000000033114136046755017114 0ustar nileshnilesh`CgraphExample-03.gxl= wP15]L֣j`?8>.J!Z8=C$*&T2 ǑCEό)h:*Rc z2 K*1 k- #fcV/Mvw8o=3[Hquu39ePI~bgraph/inst/GXL/graphExample-12.gxl.gz0000644000175000017500000003157514136046755017132 0ustar nileshnilesh`CgraphExample-12.gxlWe9H3)_5j*Sww;|9  l۶"|_޽__^ן?~_|Oxo+-%//|o~x~T??c!Oc~Q<'c~U<7cވǼy'x̿cދ|(I?(>??D|~~0Q}~~``*````ƕ 5_ʆqeCyeCMʼ6Ѽk^T/2/+/+/&%/W_Wԡ_W_W_W4_׺k]Pl(וJ`D/33[^g>G/3ы~Ezs_=9zѯ|\0-W6̤teLJNW6&ʆll7Q^O?9z?rD/^ z?8@>p|eC9@ _Pl(W6Ֆ˕ ʆɢ\PQl,˕ ы~{0ы~Y4G/D/,G/,G/,G/,G/,G/,G/,+j 5ʆzeCmzeCrf]PܮlЮl(hW6*f(FOJь2eQ2C*S)s?M2e:Q2:я2e;Q2;( DmJtP\e#(D%I(QV2@JT2PM6% })S)S)S)S)S)S)S)Syd%(/Dy%K(Q@Jt/PJQpGzʔ+Dzʔ+DzO6lqop"3)Ѥ2c&%"*(1]PbƻČw9@ % %J%LJ%LJ%&*J~6j|&D?X)S?)3TZ=ev[=eʃ\=egU<(S<(S<(hJ%ʺ2(1XɠħR@O(-De%( (QFY@2JQP*jSq۔\x6%:S2JS2ZS2jS2zS2S2S (lD9e%)(QN@rJS6Ph%`(QA2JvP D;(Qpy';@^yet?>>DD+2g@V=ej}D{)S#:S }e(CD%͋2A(CD%ʙ'(Q;A JNP,ogy |!j؟|4a)']e9W{JU2ZSOLž2c%*JU(1VYPbDz%&JJL c c 0Z0Q\8Q\@Q\HQ}^4??`M>F{ԓM)Se4??TM)S:M)S;M)SM)S=M)SArJP(-Dyl%c (QfY@2JL^̤LT PV2JCQm/>`F˃Ok<m/>3F{3m/>lF{ʔF{ʔF{ʔ6PL(Q@ (oDys%ʛ;(Qe(KDYz%;0q8K Y*X}:_(d}y5 _|}Bd_=eW{&U>*B)OB)OD%*8OPbz:Ar JNP\ve 8\%N].log{ 8[`5QK+j=ڊoE){kע7^(e{-J|ER܏R_Ѣfb%&޷U(1%PbVAKĬ@-[%fJi (1%P6HD<-yZ)* Tj2`QeТ6VWakZ4?)s2J4LE3jKZ4?hfO={UPH%jTPH% iSA=SA^Z%jeUPVV%ne5`VV'ne5ډRi@ŭViŭZi7aξyefξyufξy5cξyEc*S/]LξyucQξyc-SfO='%\DmJԦDJDJD-JO` N2'~ ePL,nLAo>pg>&eآ} [o|ar/'l;}-S澲_ejD1{2XD-J2(1ˠ,~sPbA?@9DJT0Q.p\ElO ElO@ElO`ElO_ڣ=e{f}{E{L}Am|!i݃oϾ{=waG;w(g=ОA1Ar J;gP9{%f (Q6[@ܽ 8QYz/ mT)`mXm \we֕|WDGǃ/ў2EgtL)sߐ2UȌ)0=e(hO2S(i(Q[(1oJ)A:E:(QZ;(1uVDJ{"Z;8qZHq+r"Xq+r"hq+r"xq+r"xy/j= -)STGI{ў2tTL! )SDGA{Ϟ2sԳL)S4OP`^D@By(Q|(Q|(Q|u.Pb68@Z&j:V8@ZTJXQuEqZ\jble$ڊ+XFt:=eQў2uTL)ShFE{jQў2tTLq)SXFE{̎(3(Q,gPPΠ,AYv#F%fٍJ: (1;rPvd%jZ*G'nEVd)nEQ[YA[sTVk/nVVk/2}DGÃ)S)S+9:Sf(:SF(:S&(:S(:S':SitLM]%j(QAJtP:(Q:(Q:(1DJTnDJ\nN)?1??=>W~ǏtLQ)SPGG{F)SDGG{F9)=eJF^D%j(Q@%f#<Pb6<@%f#<Pb6<@ڬ&j|&6L Em䙀jf+ 0hQLE%J3f/03x,ZO|Ҟ25}Ҟ25|Ҟ25{Ҟ25zҞ25yҞ25xҞ25?Ҟ25>Ҟ25== (Q3W@JLޘ0 (QV@ PA PAJPAg&.9TpC(.9TC*.94@,n76y(Wite+|xQl%i?~=ej=ej=ej=ej=ej'GM{ DM{QӞ2sԴLAk(Q huP%jo P&n p(n *nL. Xޚ \Tw='xqn&xq/nON/nO./EW˃])S.])S&])S])S])S])3=ef^Wť늮i](1úPbfuČ:@u3%fNJ̘J̅(1J@ 8+pV%&Ja0Qh%pJEA F+V+_@2hQjeE T+V/*^T0Z` xQh*E}ׯ>kOrkOkOkOkOkOkOkOkO FaDj%jT+(QWAJTTiDEJTTiDEJTTiDEJ\TiEN\TiER\T@EV\TEZ\TE^\TE^T:xqgqxqgqxqgqxqgOʪxz/ʬ**S,S, S<)S,)S)S )S|%Sl%S\ee* (OYDY%(Qư@J-,P\ae (@b8T/!KTT:z i)S^Bqb|%2*鼄FEبvґ@J;/!-xKrTny A ./!8KH1^lۼ7/!jnƗpoM3KW3hrOhrOI>/]ME{KE{D{D{dd^:lg0ҁ18({/&tEBqS4Ĩ%8g2&\eT`#P72 U#P92 5#P92 5@LQ @LQ L@4 L.:^. E黅.D뻅sB9n(~YG4[#-t:w  `8$9 9. cw b 9άqf5I3Ir\$$GfItddGIxdGƫI|dGIdZ$HFEdZdHEdXZdHEdYdHƞEd{n<șк1!Bq!eC)*4Pe*+IQ!or*#IQ!o*IQ!or*+HQ!orH [) )e ))R"9wR"9*DrDrd<'}R&9.Lt\2q)eޞK2qq+eVŭTH M!R!C.4B\hJ j*2V*dŭTȐ[!^J2ZdTɐ{/U2"^dHJu?_{u:ӌy gFݼ2nBQ7o3̨e[2-tu:k$V#9ζQZj$]#9:qIsNrt2^'9ή87\߸~c;w8GA~d[ix3qc>}k!k!n`dHFIdTdHFIdTdHƦId36ɐ \ }sg$C/zբB+F3}BgQ>os螷E9m4[6-t>:]$y"9*ArS(Q,+$GE|eu 9ʯAr\qvWN%HK\9WD~\ʉĕ r+'"WNd%ȐK\9!r&C.qL\nƂr&oLȹP&Cʙ 3r+g2WdHc"r!E-/9/G 7[!hйm[Zy F}:y V|g丸VI3JrV,瓕8l$ǹd#9$ۍ8i7\ݸFxd@lGF|d@lǕy -; rNddHFNddHFNddHFN\;!-r!-r!WAd(dHAl(&˨|y׃-_1J-tF: z F. FjBQ?ohй$9,'q^HErS.r瓋8[$y"9qNn<Ǚκ1:qe; <.|Xa9ȏˇ @.|X"a9Ȑˇ C.D\>, |Xr$2aIdȕ%!K"C.D\V+ U!5`ɤHŢ$A,CoVoA6J-tv: z F*Y蟷Йt[<gх8.$t!9e qWH g8$G%RIJx3JtV#͵魕ȄXLȄX L7K#B2[62$e#C2[62$e#C2[62$b#C2!62$s^#C2u2$s^'C, t2$e'C, | ͇ ME˃(衷=QCo{fBF Yz j z fz by ^$Ǚ$9$$9Ο'q$9'q>IsIrO<}g8G_$GEtd^dG.ExYGE|YGEd^$z!A\r9dz!A\Z2t=ȐK Ccrٻ&2޽ ^r&2R{MdȥȐK5!k"CK_)fb$H Oίkѿ 5-T;Fe"z 3; P> Bk[v`[Y[X!9nvQ!9n6Q!9nP!9n U|gΕHoDZɎ4JxqSo9Oqg=H Í0Ȑ `Ȑ xȐ ɐȐ ɐɐ Ɔ;rF9Qs"gEِɑMz N]A֋&z SM'(-tM5-tj4[:-tuG4[ >-tYog҃8$EIrO"$9n'LV$9n#LyiHdGFEx.#u"@2-$"B\dH xȐ C.^ ޳dvx2vܘrvܸv!LA\0mrdHӖ -"^Dd0m%$3mK$Ifږ/w[ҿ\fA^裷н(Fo{IBD&z lDoZ--TeVC&93QܽgH,DGe!;+ VYHtB|Q#} ix*rU2idVɐ!O[%C2U2n Wɐ | nlP#C252d_#D65R$ֈ | |$׉ |,*,_FH8a:B BPT[Bz ?QHo' -tD!Ar$ǭAr$ǭAr\2H ҃上ep'qv4'q;s&ɑk&ّ}؎y;x8Y7gXEd^DHEdȐl\"C2/2$"Crѽ7&\7.ldE~!Adtǝ)')H~#{"H2Dd(Yu =z7o~G[^裷P-}e@(_ ,#-td[ʈ>z Go*#TF&9jLrJ䨍22q %O2Q1zP!9n P!9n #wP!:r#7P!<.FBz)GJ~\ɽUIѣ!*rzT2dQɐ+G%C.J\t >ѽ!r e42$C#C272$C#C272dC#D6wR$ {$$ɞ(S%^)4+7ҵiz+m;?^QMoC?-tG5A:䣚BGmT[蘍jz QMouG$9Ir\˜$Ir\$ŋIr\$DžIr\X$EEr\X$Er\X$GnEt_dGExz_GnE|܆q zy Avryd]F C2r<ȐAe4rL7&\hR64Ӎ ) f&2$of"E򾙉f&r$ of&I򾙙(ff$ S3&yL޹hFE#eFEߨ:vBGnT[踍z QQoc6-t ? -t@/$Br|TRB%9.$T2B%9."TB%9. TYItPI lHȎHȏɻ  :!yQu2$D'C2It2$/NEɐ:U'CdH^T CdHb [l!y 2dAA5H=1 G*^E$w}$JdT07$MIa4'ig$MH;rQRo(L[&&J-t!%J-tYz ݤDCnNB7%YQc$GM:H 9jׯU6:HZ 9YǍ(Yutc;wV"=n߮D|\rs%JD-Ȑy+!V&CX ce2ɐ;8V gBƄ e2Άɐ;V!gDΈ;'rVTyQ!GnX&f$-%yrr 4$]!w7r֛L$-ޤ"顕4KZa4^F9ZTohЍ[4[--tM:䣩BB7)To(СHy#9Frܺo$Frm$Nr$NrT˷8DG.NvGNz7㜧8A$Hnqc>}g CrW2$ C22$ C22$#$C_ ? M?M> $,=ғ,,ҋ4,H"M6/^VQ|yʃz ݸEGnآB3jz ͠ B3f/aߗ@h%{ Iz I>HI/!1 %$9f_$,ݗ R_JKIxԮ~)IZ/%Q?ER 1_JKIԾ|)ɐZ/%R$CjYdHE RXrA΄ʍ 9*dHƆ;rFT /))r%%F./)ArwC>9;D,%ICZyIIV^R䮕4k%%MZyIIV^R䮕|4䮕4}MC%,M:kz DSVB7Toh Y4[$-tSIy'9Nr\$DžNr\$ENrܡ3H |1䌨srDΊʝ9/*w^̨$y\r$-+,ɻ$RH|T$ORIUc869RODHzTԇ{FVW7\Z1Nc E-{-$Iț*GѰے?), #ygB5awy@ņp+ؽ^graph/inst/GXL/graphExample-16.gxl.gz0000644000175000017500000000443714136046755017133 0ustar nileshnilesh`CgraphExample-16.gxlMSFH#}J9W.ۭ&N郫 SY^Vxw_l׏}xW_w9[mO/.ry{Az~9?<;[̗r{7yxw'/䳿Xk`k` Y5`WkG lgf =Xsk` B&*U4hZѸyE?kmMRYp& sÙb`:\fɿj h󴍁h2awM"f}h v7ڽɇu` Dv/5"Z DQ D,ȖȖ}5Nu DF6"iTFyֈMF| L{7qV` ^ D4@Ĉ!@@$kqoFDa2b c40@1X>f4;{Ɉgn8X>BL\ݶi ET$CK6Pdۦ\ Q@TCҩ :f4rCm /|[-0 s˧s0nle`űuMJk@'3&7vn; vZfk ثu.`UBsW] 4w7ucɍ}/ j)>`QZl)>`V@j)ZnjxX(muMn( 4źX7|Qky"Ҟe-:Y֦e:Y֮0JC <@C`;zE[7uٺn{DMn#?Wo(4){10)|1vǀZ~nhy L֟ǀQպ֍(uúpnvnvn"ymBO*HBO2ʣPhz })0Z)h@ h@i3Z7ܸ HŨ`ͨ`FZ oݨ`D``D``D`8KqS,!Zg :KN,惓' 79CU`hp+ ѶT048Z GR$g ,A%hp NrIΒ+49ڛ灁T0VZmNCoT04ڝ TS[j= ֧T0KaU04YBT%hNY8KPg J,AU%(EWq%,:5s@ łwRIUPvi*.TC٥`(U ֪^U0RM%-VC٥ͪ`hP{g Ywv&p\zU0گ TւU06T+Vڱ N-YCNj*rRkVQ%tTg ,AP%%&'?IenΤ2phU04ں n\CgU0tVi*:z v\%hFg :Fg Y@3N4qݧ8M 8MHiB=7Nq͍Eln'(bsDAj *]eo͞mќoќqќsќuќDsV0͹uhYB9'g 朜%(sr,y!9OНy"=9OP' graph/inst/GXL/kmstEx.gxl0000644000175000017500000000162014136046755015115 0ustar nileshnilesh 1 1 2 7 3 1 1 1 graph/inst/GXL/graphExample-07.gxl.gz0000644000175000017500000000052014136046755017120 0ustar nileshnilesh`CgraphExample-07.gxln y =&$TkR6Uuԧ/8b` bψ+)1xMqA*YzMHuYJf 瞘f4ca:V3*Y#`p ǭ`/ 1 ”zBmqߣ*V2XEA J~,!BTu 9!_R@VYz$wi9qJ=rȕ;>34a:{t4҃i0/>zz= MJ7iC< |'N^᭿H帝~H>graph/inst/GXL/simplExample.gxl.www0000644000175000017500000000312014136046755017122 0ustar nileshnilesh main.c test.c 225 316 127 27 42 graph/inst/GXL/createGraphExamples.R0000644000175000017500000000035414136046755017200 0ustar nileshnileshgxlFiles <- list.files(pattern="graphExample-[0-9]+\\.gxl\\.gz$") graphExamples <- list() i <- 1 for (gf in gxlFiles) { con <- gzfile(gf, open="rb") graphExamples[[i]] <- graph::fromGXL(con) i <- i + 1 close(con) } graph/inst/GXL/attributesExample.gxl0000644000175000017500000000226714136046755017354 0ustar nileshnilesh main.c 555 1.234 true false test.c 225 316 127 1 2 true false 4.5 42 graph/inst/GXL/graphExample-02.gxl.gz0000644000175000017500000000041714136046755017120 0ustar nileshnilesh`CgraphExample-02.gxl= _A[cu2.M,T?_(e!5 '%w8}7j6fdO :}U {J#ySkEFG]g_WEp#yӊ  9lҸ;QL | @2 K?Y§F<Eb,1sV`>NM4 o@E{f \2&8/('Egraph/inst/GXL/graphExample-05.gxl.gz0000644000175000017500000000026314136046755017122 0ustar nileshnilesh`CgraphExample-05.gxlm1 wPW#:5]LM$ H7K޽\yb_FBͯwk65iXJͲ+ c"HD /59ֿ4Jq*-ՠtbR *'YQp rgraph/inst/GXL/graphExample-18.gxl.gz0000644000175000017500000000030714136046755017125 0ustar nileshnilesh`CgraphExample-18.gxl0 E~EIY:w  {bgҵK~ӐEdfiX"n\; MCG[7H|wW%oz㺒f@O)dsxЮOSIa91FG_npARn |K,2]%JjrRt >UJ:Sn!xQ(ތ{8W߽G2fCqˍF'&&hGs <1= w3uoe?u:graph/inst/GXL/graphExample-15.gxl.gz0000644000175000017500000000214614136046755017125 0ustar nileshnilesh`CgraphExample-15.gxlKoA{`fwvV\sMke`_`cRU,OYJeج']s8v&3|=v?]N٢v}~Y}=/'~ۏߧ^4]Om:4J\7ۻ&4&4 y$4 B$4+BDh ͚l͖͞м9i MGhzB3Мy7NMN;W_U@L OSUa Ж#G¼Ya41%@hx3{>;EqO ư>,b @L^(b0g?,b)Dhb-@̲@/ qT|sw12V1} z fc˜b @& 3@'~r s*3y3)x/%S̭@1q5 J֠-}*7TUc(+e/&+epQ` GIǕ Qbvzbv8WbNC1;ސ +IfDbH)%a;u 7zE%@^$@"^ 4{7$]TsPy5,K9(RAq:H9(,mpsP8JA$,;FGQ#J9*|(𡄜‡r\+1䜣Qt I:GfsTBoPBo qVDwFγ_xOzxgDgސ p}o\﯆Cv<&graph/inst/GXL/graphExample-08.gxl.gz0000644000175000017500000000066414136046755017132 0ustar nileshnilesh`CgraphExample-08.gxlj0yA^, *r}[{q1`33G$O2Jg=Fy<17̊'L,vzQ)eZ7 ljS1ZN3u!Yēq\%k^)*4RϰbB[N\>!a'pF main carey max min a b 8 19 graph/inst/GXL/graphExample-06.gxl.gz0000644000175000017500000000040514136046755017121 0ustar nileshnilesh`CgraphExample-06.gxlӻ0ݧhۊN8[ B/*<-`rIN6* Yc@5w8etΤmKXMۅ2! aaOkDp.q&ԌgXe("Q~ >\v)4%Ԁ4(@4MXy$V˰8dǡ1h LL0Ѩh&hL4圉 1_륪graph/inst/GXL/outOfOrderExample.gxl0000644000175000017500000000144514136046755017253 0ustar nileshnilesh 127 27 test.c main.c 225 316 42 graph/inst/GXL/complexExample.gxl0000644000175000017500000000565114136046755016635 0ustar nileshnilesh main max min a b 8 19 graph/inst/GXL/simpleExample.gxl0000644000175000017500000000130114136046755016443 0ustar nileshnilesh main.c test.c 225 316 127 27 42 graph/inst/GXL/graphExample-01.gxl.gz0000644000175000017500000000046114136046755017116 0ustar nileshnilesh`CgraphExample-01.gxlԻn =O !6QLQsK8_Ñ+% 㫺q WbΏ.<,8Jx}m[?g6,Jhyu`Nx7:93:7&ZΤ'uXeD dR 2ɁLdJ &~.8˜b315aѸYsj4&!F}4^<[b9AABѣA #%AHԊ kFlʦPk]y sRMgraph/inst/GXL/graphExample-04.gxl.gz0000644000175000017500000000173514136046755017126 0ustar nileshnilesh`CgraphExample-04.gxln0}6" nHxX׉c8Hq|?X<ܷlgЎjp3iקӻOnh_oV0>Ît0o?04Yv_ֳMkL>/Ǘ~S<4L@@ y5sP5KP5kPj6f jvfjAԴ5|l;DZsAdBІ> BJ9#D,}Dn" C&$"H"B!hGP߹ " U3ƈ"5VI5(?krQ$ސ\ yX#xGF0˖?88liqg'mBM|a C6!q&$*1[~Z@4ltܵq%72U̎Gq%lq񛤍̎%mhv 9.!q%$*4 8<&Wj+5 w8<&rlDqyLY// q[8z=,!graph/inst/GXL/graphExample-09.gxl.gz0000644000175000017500000000077414136046755017135 0ustar nileshnilesh`CgraphExample-09.gxlIo@{^`rjz1=jaQXQolz0a0ߒk]9=a /pW7g_Yspp;|rx6o Ox3nO 4 vvkr[7.vv#9nbs?>!bD!b,19S1%#bDLE -ڦt ozb‡1Fal k0ω$kK0k fqB F!SDQ9MP*b@TN *S4MD77 19D  &bB@vbfO>I 1}Pɠi"/1i@Le*y *y^ 4MDŗ\ )R+ )11JQM1=! f"D*@5 :DU/T=C?]u:D6graph/inst/GXL/graphExample-17.gxl.gz0000644000175000017500000000245414136046755017131 0ustar nileshnilesh`CgraphExample-17.gxlnGE {K~ 16Y$ S=ÙnRSU׷ݿwǛR_>>߾<}Q>쿿<}~}}|:۵<f?}op{|87/1CфKB h-j2`E)o29T1#Ι "99-#.tl1Nm]+[Et͎M6*^}#YIiRfA*P,yojrt Zq踌&fڛ@ؑ,)6(Qh: 9,AF#!U $Tiyq-)E b/9{V١*C!)#RT1mB9:T!29N;#Q&Rr2`#+7kLLSkdNvUbGET U dxRoX*JQ*E?UоB3;%3Ԝ0хI&G؟E^Yp Y'N%ͨbQX3/3J+&lh첁Fߨ{ĤX,JCPw%fAԈ" 1#NuѐY(%Ely>=5R, ͂]qBn%ҭN5/IA9k^3t#uqNֈӴnQQ&V R#+iFk Ejj*TաK(&ź0v IZM4C{$-nK<]H=ln š0kHML=h(Ly+5̲78=mZ$PW'hTv*7Td {RԀ*z92T'fIQ>mTWh#(kjd?Vk/[ɾumڥk@М{؍î5 뤑pYN׋NT=[ykbԓ믯T{JQR9{ݼA+Ed$ \-zEwT=hCQ:/hkDME܃؆bWIJEoFȫ:"WK{k%/-`յ{+7C:e?Їƫ$.Y٠yxںgƠcn>5ҖņJcp!oyԈCn46daUXk#X\`A>jr/zPԁ%.2Ԥ 9eO/MW t6,Me~ 'graph/inst/GXL/graphExample-14.gxl.gz0000644000175000017500000000064414136046755017125 0ustar nileshnilesh`CgraphExample-14.gxlOo0𻟂>4e +~G8:]NtK} O2'"X"Ȝ#2"S\LEdnD6#㲴`zF9f֛3 a``-zc}^0,0=S@)I8 d4 .瀨B@TF1LD9;4BI@L#4Bi@L# c05Fo 9&>O\bH+@LMZjbZ瀘1!꾵w<=CI graph/data/0000755000175000017500000000000014136046755012431 5ustar nileshnileshgraph/data/pancrCaIni.rda0000644000175000017500000000137214136046755015133 0ustar nileshnileshXKo@6C"AUGz(jBRP  !r] A!ƲMJ xm( Kd84ElC UBOQEK}zANQ骰Z/=pZ?4݅m;uȞ^6?{j8an^YM4^)3Mo[xvc<5܅aхtjN>[ݺ} {!ؽHf>.e'Yd)>=u_-_XZe^z_j޿_m=ͺo^V\ .bJ< _&Fl#T䡔h26?՟~nBMF! 9y̬C"4(!CU%FI &ӦPcHBo\Pė<-II'ķh1?=f\6![9|Fl4G˾5q}ɓ-BDm^-l{VSN 823na X䜚uҜE91bE{*eT!-cc9|&O.6/ru?C)8graph/data/apopGraph.rda0000644000175000017500000000210314136046755015036 0ustar nileshnileshZ]k:vlбÁ]14mӳN=g6^V,4Mtq~,Y^at* Hzx2wi7O#zQӴm+-\,1Z~j_"v! G'|~>`nEi 5FOS"wKL>Yc?ė.g7ez6OX,6{<'o-.%ȓ:Fn]%_n8MB1|Cx$YmC]\~w.x"Fhd/iNVұFG+ltlQ%>U%>S#VJl BccW͐ɉ>6RMPB鑚'eḬGllff0TW‚1cTyib(4BݢM*LPTnZkC͇APҡPOCOwR|̒~[ 3kbnAISaIXM"a=1!_" QX7~?~/;a ^p)Lq!xCgCsE!>W+s3QDa*=a\ldj_f%graph/data/MAPKsig.rda0000644000175000017500000000136514136046755014361 0ustar nileshnileshXKo@6`HHP*HS!L"eVG$]j/ffʷmY=G,eZ"giX ]^LZCTuye*8ɵҙ4(M./&)_:x* $o<8WKH7u^0LdY Xvc6g?ujaaS]ً7A<>6 s\[ }Z3\6bGFdjIBFOO87<| ֹ}:>{gB1N#b띫,ژxdd;4 ##4NN#1]0Uegˈ 0Xq@w'L!=8bF$VVf]<=;㳃wa,fd yso7qd<[md s3NYZ cc`0I/yRf3{f80$YGZ9'Na')·W6Lgrٕ 2 ı=fHsxm hqILkD$.Shq?Ҟnb+cg# $c3Ω/b;ffkxLlo_OӉr|%1ɘlV_X\H<(ޫ^)-Ri[N-I~MAp*1!RpS[ %ʹI#m7]OPW@mԘHǨe3n-iƲmhv*`Kg`@.?b&Wu*]gbjL]&,EZ?3Xl:s)m\)=`P#XXxݡL_>W?@Y]+~u>/kꬔ<{rY.nuBJfGZWT[P-c.!3hU82 giOo*:u_}rsV줨2mׇZ\_RkھڗR-%A?Js/'ab o-P㻟p| [zyzޥ7&VI:HJꮖ8N 0[_DuYI*I%$TJRI*I%$TJRI*I%$TJRI*RV}JGt\No#YA {SVv>_tx}r{h{E4Jo &HfJLQ2p#=ax;Cig -1`=ūVFi3`_8/0yDJ!tA,,rIs{6cak<1Gh!D:V2"N9b5 ؊,{m:CTadѦ ސ@i!<ր1GP69pd'TqVBЎfB@- LGw0Y?Ē*!pV%ELR )(e8^FY;XyI$:̹y"6e [0O4gp#U"(P,ieDр2tt9dFKG,gx YNh:80=+;C K4_7Dgraph/data/esetsFemale.rda0000644000175000017500000016310414136046755015363 0ustar nileshnilesh7zXZi"6!X=])TW"nRʟXaqjnj-&a{G%Di]_m6NxZ Ďƪ ,[Y^ kM tUof5G-> Vk'O.I:4| Ex w8"[m_YWm[]jhj< l5x݃JMrLsP|u b I'm_ZYXy:])䶅־LdHw>z=Z IjXX-{ɣE1[SN:jQ(_v,kbevm(Ͱ!X{#~9p;{-+(-U3瘮=,b0K}:Kǎv۪|x{feҝ-?mĝSS 監>L=_ڠKEk:Pq?&ߊ мcRDU;xh;dV80 |\*|jfTkL3lzPPt۷኱S*^V/t(F IΛ_-C'\ڰ> ۣs5;JaD] 5hsȥ&PfqɾH:m)^+pBw)<6|aLrNBP,@9fU!M\LM5vBA.n[#)q,Dw__s\"fo1za=qMݲ2rishrqeA3 aV4ddY!QӬ m2,mHNTtfk-`r9jnI47#rN]\=FGPmxy Mtb_ek,Sj5I3b9. e:ʞKf5瑼MAo JYc;BIFx将zjXFF{vߑ8m3qcZ_.ب\L^0[rӠJWioVl7D=OBy#B۵Y+;Zj&\9opZ ZTuE)ؾL3%Dgc+JH,n-|yWҘɣsŚ7w?uHKmTh81n#'9wR6"Iۆ~nAfy\/gO aii' p]K=`z&Τ'^mA!#!b3#㖳-/> k ׼S\>Κ&(@MMvM+҉f F:(l܈s%Xϐ]w_DU^l|U)jӄ1ZX#+*\ASBD[uwlU*ۑB~}`Sr/*f)u \7jMZo'Hc|$q#2i'gwza5hwAT" w?[(ؠmȯ`^ n Oƴ5CKX\K&hS:F_Ne\wjeluKE\S\=Z hB٬9ǣ8&:;o}䓉pa6ԝG|:@ &MU J(2\+j"_ 5vd9:ӷRӧ?i Lc ##wgrNOHXb&G[S{kIՙK]q\ف۝up234p/ʈ9e7U\{sBϪ[VGczqHƆʿv>I.t3 ״57t&y>pAގbLΐArE;ңTao?53e5Ҡ4 vEG:g9Mc{DF($qdQP# }G>״{ ]!5Lgm6lfA ҽ :ԕilDܸ(*̀!|;{Af$S˹#WhVCFn҆%2|\ OÆ4 dS›3ggWxn~IX/#iCYd]ius`腘(*o\]=?7e|ٽNB&]) lwX E,'\6Y_:kljK|m{Z:a߅$Dq<ɽ4AM1ދ)HyZq"̕?G hztqfSX 9svsiII?+ 3{qVUZ2W%^hbe8( mhGߐ^:%@mFEKXC4[f1Hd] pГU(cG/ $B,Yg;.(Q@XW?Ґ-4Slz^\:sF$B/T|)ZG$mm+D<4虅חV @1DK1xvq0&T0c C~vbC}#r,DOUL JP$|g3^|Cc?G  OᧀHnfuaXM?Ǩ*5w)r/N7W] 4=cR^F~RTy< X%Rl^q1xq9*iBF{8 _<τ*ZaJy9 wEQ4l!Z1ߗ)Y,1>lAઆ5] q%2EQo(LH [frmҧ*Y grzs%Vu~ԍt .K21xƥR>DE~]L.w %QC\ Edqj Ip696PhnR_[ 'klҡ$F~$6KUsY^O-bc@&*[s(a,˲L{6MeP"9ۋH2p, J)@c΢-k]N4p>@f厼iȸm$ {d[LE.k7U]cdM^*@UAo[#(}#8D5? [2]k7k`n@:׊ g0'~d3\4^-mcFBGjGI/HtuFîk_9#)~)XUNc3p&h訋u>*ʻfjX'R~C;9|EXV7}GRH*_΁p *Y2ܼ%2vfT7'Tn15~\E֐q"܉`N+_<6^4Rxsp?Kټ𸫎j`1osAj'mjn YI’&{<亻$?yL$HDYsa%?)f-QgU F:, `dxs˶nX ˈ*uHEdIG%,f6+uEԪW}VM/ʂ;U.4ʝ}g#=Y6pUALjd zɦ#ŨJ7^U޲KF糊&%m<&mLLA,dŧP+z%VG{.-  MW*q:a7}17b,cC;f\`h˭tRD ?=royعRVSV AI6W8C[F!_0\ŬsA.aR#, n>i7x_)XSovwRSb]/~{hYBԨh,Mj݀TEp F݃E 3 }͆a|sq@ϸYdq12ovೝJCYMV FGc89$V|YbYX8IYk KH32NМPu5'eAe?IcJ< `Ovmm8x8=WD4ZщBwܺķUi顟Lئnʅ h`.m4s}}%buTHaO[S|iB5Jқ' n[a9`Ӆ,ɍ=k1N ,RzvE9ȊnM_KljvznKM]@t'SCV`CBnX'::"f1CW̑h$z`)Z(lͧq`ƪ_!0}yK*<b2v5 -ʖ#b>!6pIi `S.HT:f;Rά8R((^FӝZWN1v $WR |4ҀEXʴg{IyPI{rD*c~}"6ؘ%j\~J_Ϳ3MͩQ$ $h!6D iB-rzwF~8MZ-]ښP}E.peΠ [- )-\5C;7uo D\}ﭜ~hJ𬻇y(M5<)` @ eku_D6M5wl-Bl %@6\ |Ħ$ ـ2EոU(=tFjBN"B~vNȽ` wk;nާˇ;=+=/.Sc mE?n~J8'ֻ)p酀X:jo0A;J,$N1h M|Y4SΓq_`ϊvjeQ AofSnQ 1`2?QQf h=\|_fG$"SO}ҍR~p%`iP)S$<(-jA @BANg: 70d+BЗ9gqd$@fI^5%sAUOBynafً|[J"Р |33'm'6WB z IaX0zBO2i?l[GQVA;xBHQQ '{eh3sٖ r I(-0Y*F0ek>]Ex[dNS}r̵iiXC3O l @p4VJx#Lm䃉a\ʄf\*æӿ>%E{ob(2IjfϪJ_#PKDz 3]?Z@yYG[+_C A'aXa.ze|Dh{R$ "".*lo/tY>CVعtE%6||i:Pponv_7۝(8wn.# 7 BۑG9udaFąJ~ͭFԩ)RjVS.c`/r9 .LJ6ֶs=ҁtR#i==|SΆN~+>.JiZm =K-һ+(޿E!T 7=YPxO'.+#c;( ϱIBOy\laȞtʂ1q ǡ#:퐔DԾ(8Ļ|zO[cx?Z2 d(.z#"H+0BDbУ <t!D+ E9O~=Imۅe͞ Gq{av$܉]풜m6$ Fa oS2xINwnQyڞagPDRΝr 0F{Zqkv5z"17'e+/p㐨r` KsE?l11^u[-ȷ&e`%ld2n8=2Aү@]/2^€P'I'qWˡo(>98H8dr:P)sQ@썟BѪYpR6/@03OSiO풾y7lԱi֨ޫnw`,?),#tEp.iu&?+18R=}$a!=Z)Qb7I:3ļOFl'լy'Otue2RX~pې3!u/2*Kڥ%uژQ&PU 26]+1*KX@oPWó+n4D{3FIYh'm[Go,I! m6e0ufQl#GcX`wǾVoITrM, l,ʩI^e@3$|~?G6GjOb xw9f䱅tS,\Q4oIL0 >b]<ѺhQ邠$w~a\i obBO f.0A?"pu@v"9qcG=]zl9J}BWzP=VY=?f 翾^(P>[8_q$ (#vPb?poGOhT{8Eu熞L!dz>z ϞZ^` oA<?zFd$0'j>̂?kbY Vi,o\KÑCe~ayMU`Xwevʪ3􁠪 #+m?o*h0=/"ieָRw;^$GQkO @K/]ᵚr\Vla2DEpFGcO(Qԃt,}?Ge ڙxSը(e3[]iKptȋiT @Frrݛ#EHG6ٱ P wID?5tsDqAv_.YՓ a#`vkvoRSkEUx;- 5PkMi'T+QtNRŠCYF/gc +6=:gb|5r]8 r rmheEy5҅>2uNƖ_SDxS:T͊>]n:";.W(װ+a kI D]WKPdAiFMz9'7'PQ!4C\spAWOa oj{xN+zQ>49 suK- |ѵ/;07_/MPƏV}‰j?QSlS3QJ%׏:)leIr^KrUC0rhױqo3H=τAg^* eX-lGVX%C;5K?Ӯjw!`-~e(xb?J?g*QN!U/0EͥYIA4˜Ϸ;[eT?o%|y ʐ_OFӱ V52eۗ%|ғsFQ#8l9t&"bm-7/H 1=X%ֲX&]J ZMoF$xxIWla7޽]ΫBBB΋_Dq߻2 j ">+j=SBdzoD܊z [ݭjvoa“ N[36$?&r/np\H[X*H-/)A|*81=5Hm⺔0&f81\tO$V]bdhc{tx^ <&ˈ`5%Xh/d- ϭudz8":v[^zxfh)w-T/~=Ɓ%+' Ixxr'*M}a(i hjynEYX)M4/uETG?+,MM3d{h0id~K^]%tLR~&Xo P=x)M B -7pYw }ХZAa.F}лebPVj2$q1:-9h*tݛ7~c&%8~JUna!?%{ F)K/m~L֯)MY)ҩu&֯<%r.,}Md"d3A ~N$=dȽ$BЖH$iIK95 (d;Á3Y!CYEiS۟ZNX#@Nx'ٞpci> EdS;SE:y+"-û$30\6{3L[6Rc ?&hIQ swL|ɄWC=WYU6*+S{戜[v٩ Qz%띦:_Y RJk߱sgdUw@"$I9uigZ%gbh|VɃT$d[-ݱFJv$“`qP[CrK괖Y|LLLIl?f@[e3^ jzPqi'MgRF7iC!Whi܃u4 J`Mr`6käiOe·dnb ѧvKkߑ$]iWue>XQN5׎QAZх!f?wǂu `x߯ bP}-axb4{;!̢LGpt"{G6ԟ.UDH˵aDa-9J;(Zn’vӦXps1H4,}͕/kwR3oׂfZ$ QBZCz˕&i/FцA:63ɯ4QUvt8IW .D<7U+1&0$.x~"Џso(lmdHG7tC|w\?`9:w3 Eb= +L H)!pSxN-7^5)WN =L:kDK>BXH*eO`Q{zP,>B5q.NO~܉n>Dg@ݾQ@R450sBՎN@ b@mh-(ߙ3a%,At!~G°ꔠ^y°rٓ6i6>wLGbgqw`G z7l%*rKuLb>~lay5$=\Htx^:*TpR .=V4>>T 0#߳P4@R5Zop16a0<ȷhR6pBFx% @~ {2tCEEhcuy9n4f9/Od+~(6񈜱cm=)Ǚwuji"G3jfͩ@(#Ď9MƃԙI@w[X-8T@$xAu*W~^Qԣ鼳d3Y%Z7Xy5w"v Ari(\gL ٛ9x|]LhiFPڙOα߃[gvvS"U(l`B-gBN}tdZ WNaJB7uy{嗳V'W4 ( @V֍MH74dBwDcwWWfF8gEh{I~4bޗ=/;10 㼮H\-l`X/+xeKВ]gD"jK*49J87"tu_~v`~d0GZf}Kf@efJU!t>n?N'J9Owi LW!nxXqX" R( -qo'@華 ˂_z ػӫ d!].5'cv3}6RRTG'jy$C[.ӬCⱏ3IzTn$T)7v wn6'!]g cP/4? Z~G˃K}u*yq%$2\!;\Vz3Hu5zY}F|O]Y&J>wT]kCb7tBFQFnԲ[[x36ϲP!r\K);45b&B0U9dhcI#=yt 磡ףK?*$Wt"-xy0,"C6;ixcf;͛MJ GEH"IF N("E`o/[@h>*5}Lڹ3r=mזLo;'lᖍJ2bji4-@x@Vgi'\(u.rǘ6]rT)XGr}ӏ0E#( zJ)LzMණܯ&Bj90&ydW:YRqdKA"( jb˸|?T7zNYNsVMUg@ WZAރ`g#Ә2i?0G!+/ jCgJ^t_Iz( 6vЇhF]X9x]uD~-n!$v=zX\z f*^ށ=|f-2-(</r"S+.~qg`TIz&  Qw3PHtlnr*9 .2 dIB(qT C)`4,1Q4yͩ8lԣAi ̓N"zf#xzʜrhS;霢, a'V\y% ÔБşs= ~)U9Eii? c6a<4S8!GjAN%NRk3=mU6Um!Zm lYOU{c(98I8{;qJNLR7@Q|7RhMߘMztnV#PٸT=bXq-Yh2&?yu.1[0N+[lI;,Y&:"43dLx7doWщz 6 !(RAٛy;,d=5%Jv[&4S[uRa*py!eY}T'ϰe*#_VvT.H`PEM%Gy63Ùtmáy;i.r,o}ea+$S`3FTӶh Ija DT~JmZOvŶS̏#1 Cd35o#Ya-$& `n~Uz)'GwP1*Rzk qio>fHҥ~n."k$ 1[oe9xajR>Qĉ!?](~|acd^X0^Wr`c%?"Yݘ7Ocw]F9\OƔk,|>%8jkAy1b - E9U`2);)VH)eQxݹ{-nQ|AsC@;4G.9Dƀ3# ˆ,Ͽ/UTot ?75 jZ5j.=ڪ?fcB VmAs*^)@;BjaމMB<O񝉩[%"C7Se]㿯0=4b M^N9Y-'"a&z\a +VO1#&|c(,s vSӬyrƄ>5 mHl~-g(& c"l;W^0B{cv߃`хΪꖔfd+F]dDq~)@[V{bNwg'Q @6r(̹6PV؊f3g}IuWsى hhڞ~eh by4 0{p1^`48iH^y7݁LJ1$>^ػ_P?"BlUכӵ%r'3E/hbBKtǯ?+=T,A4.N6z> sVEgsQ1-.8aZ}DGPB7lN* I;!}Oe.ughu̮FfԮ|waa"kCOs5M@KKzKuj=Ig=ɦ`F,Xvj.IfQrQbOy2~Ш$ @SGܠJyCsk@(G8+Rm|o7Yyۀ}x%V݋F g{k'Ĺbv9a0L':} CJ,|D &hPA{g.VS&h#{I`*@rM ~f$Y<޶ٺInkPпGxVę9"[P։`_Ek{Ҕ#$emSC\N%ukUɾG]OCֆ{hmBg4N{9"[׹lʡٸ ŒgtaW玧/.SZGZ%@a*%X]HBȣ|DڴLfGll(r>S\@l< GQ$V'Ň`br oEswxzB頒۵\Y a&XJ{D:ÒI)53 X%Bw~v$Y1riBnwHNU.fvQxh` .{5LTbpB͹[rȗr{9 S!%kr}ʌ"A7d>ËZnX ؊+v]5I"*7V&c1\_1IZgP)5nCvqTz%d IzA*^mBٱq|z#1/y-~񺳷PgCŗNZRcJA T>>y# KsoT:tۯةw}BvVBjJ*![>MRP}]+UiἽ; :s>_-(vyիU]IW1}6Ž9KfdJr!P"խ@(I-J1bͣeŐK`i{O}eI<: -R$*d~D5(ZqFq9VZ+69,|;t`2]* u'^x s}ȱli+Y`8E9.Ui<|:޻Č(HyQ?Nٺ6&a&㨓aKPeL8hm~J0l5i`?l1P]՞g|hf8#ͅ~f@@^}w=AR=;r@y`DîyՁ3e2D5%i)_W!22b!j1u@mZ?唌/:ސ<|=}=ȵK%>˵d6 ]ΪhM `M\kg;iXk 7G?`!v{i$0)c9r#Iܡm_)w#/dR)IcwOQ`qd$6C15?\`± 6sUTGksluw'г`m= P*Kȗ߸}L!CK9qE8~N~_${?+& hbxRqvİOMf4b*`O%r(F I/-{8)6*2բv*2ѱmQ=fvvR1JLPIkETz"ktQW)$-&@,5 ŷqd`/gJS;36(LƎ6Ez2mACs$qP[v*+ %ryr*]ODTPZ)c]7Sam|TV#a6rE;*s z'+.%gKs;[_R|9X X,58Ne &  NG2?{K,E~^X$c=Y94'0ha4cXTO|HCr譎otԎㄔ+klMl;T-|0|sUTUcR *!klr#퇻N6Qzlӟkg ^\@"6bƽJfQEJYZ=(B䐬Ndf9Mi ;R"艁P( Ňrz[x8 _uc#`1)?4?;Ԃl d Y@>IkMFA^Ư؇gu;.1%-? 'tDm-soLn(gLȦ](1ʮg^NQGAZS! $N|/,G*&6E` vH*!~l„"R2lߗEƆr~W|'ɋ9 &G\ҍ|TU4*e' XӒ)wf|XX_Rf\+=[%L8~[]m>^A΅ZP>rD v!Gl fG,Lr+|Ad>V@ͮUبQ2h"'zyLY:q40!*7wd aHvk1"Q<B$o;zJS`PUBۖOA5GV3Æ~M":bFÙ8@eGðz ʉ0(R %y8Hhr9Jƃ ;SIyų2{Y qLp$EصR(79<$lqf^7U)6ENH'j+\:y*F|5'_hNk^fKjiQ#з O,ٓ/`vX~ǣ8U韁4حө. <+w%(@Y`_,Un9 L{Fu%Bx4v|ktyӸjFϏ61@lM@?eE;>pܗkJ$cNjASU@j!UUc[CHnx0G q"&1!:=J=1̫Ha7˕{g}~>S5 I%u65k"wny Mi^Θ[o~4lB!bJ(,\uJfcYԂG!/VGZ3hS '<'>OU}`l[ɚnpܹյK2@4k7ZXy6{!a Ի5.[>/W/kJpYCa;6hs6UheR30 n/NU`7eÇס}^-¤%Q{6r5׊L,/!vh/qi&w7BHxYHQ!(dP6sR:Ab?2YLe0DQD2df@ JN\9Xۿ%Ǫ'7+񧖼( =̭ :p.c P> ۉIQfVZQ<|B>BL5 o@ZS΃~?8j-t1,T|J"v!V t8E;ɓ mz_)WMwJd@;;]0\UbbV1xAHSsv ~{"c>`UpQc'V9a˗>;[R RlJ<sk/Su0F}|t L9L,4T)<܁C'pK ﯇gk9 3 E{#w0f%ʳ}DǖUg q9օ㽄aTU"L7qn8F23e{<Ȭ߃%]Y*'% NP˩j=W@ 1gTY=ӽdrȼU>[7[$رޝxH϶o|'M"*`bL6?LĐKǺY[doSט3>a5޲ 6dz*ïdX: Zh2~h^܄:gӫS[T| QPC TSaÿaZib6vcϽkd}!^l^N~`'<Wy$s=5@IQ Ixjc`,]j-jTl"_갑~ }(XnF v1 Ⅎ!|vF/Ԋ05'˸K,̹-ߥo m ^?"Wן45qZUt`y+1@}LX4-o~YtkXcLԒ-a,א4iL n ]9E{q7S>~ 2W-Pf :dBVik` "p?7[)6 >\)c} qsfOjTB , ˘>[zFaz%#$H*#*=,Cҵ3"_"ܗ*U+Z;yu@5xkf45Eup֋ ׏A-PV+d osJu:u|r]Fh g*9-~Ebjh5sis O7/j#1:V/Df@/ٜvJ"CoYa|zlgLڵQu|=K]=<&Ȅ#"([wUQ/NNȁ+cɞܸp X-l;0pNlS3GUfg6}sꩍ{hPs$ "j|* /9h\8,`eUVIi02R*́ Es,aG?kw+QMW~kKZ{-dg $NK} %NnɊfO^S *" d&7Ge ;.9tE~$4[OlGW v&u~Cqt ?.;t"7ek f$4 5RBKUAHXUZv "E^;QZPgBg;ғ wPatA3˛N?y3o30ټ:3v(| =u6|=p " y?nkSWd ޼?Rg^p)GyS$ZIVȣA1ᶪ6GѫC-B]"`<b(}d ~q{JYSro3"%0?kOĺ\vV%Y>kzm揈[O^5][ނioxJڬM-磼 0#TcGkVF> hb\sn*/#ɏPjI+: _ kQ.Qrs{BJj,}cƉ(\3$Y= Ķge8Y@,FQ2Bŝ*Hv]ohA6*7ܪW{~D풬0W3v[ X |QXQT'T x,Npxf%1k] 9Hx`Jэs ~dŰ~{S_nh+ٟpJ# CnxkCk9ƮS bf`x'nk>qQR O32b}!vj?ɩiSgTeqZ^t+u<3]fnndG( q6\SҺg1`USЇ{8^;a`v;2͌wr#Fξ-\ Dys D[l*;c f/˰fjoA@+ӗ-|c0?௴ h$k0]AvaWMQ̙ D ~3`:u,HdgؠxN6Uǻ3pVg}x=cmUZ/H}&}2GXITvWd2]vvllh,Noi>$jC Hg`?XJp]|#o-" #ҹHYj^F?m]F=ը1lsN|:f#z 93/aCS4@Z"sm&oy\Fw9&Z!{# [hTe7%{=pnp^99#Z8'`ܘQXA:+xZ!R{ %wmF@CyFyo 󄥁{_ImAͱ10Ԝ)T/vvB_ C)yrƄ=PЇu_KU.^pKj!_srۯr/1Oa<0ISOoSaG'"mR ؜8 o~b،޹lb<̖ZH[ '~i]̤Ս2JCY(^:"G54Ԗx0Cf{ЪV_(1!y4|ŕft߱qc<(@mPL9̺6}@0?Ys0`oL!D0>\" Qr/kݬMA,YA_QP| oW_2@b]k*}Ztf(bʁgzor,\zx)v=]kCۑRFjcVo+|]&R27տ!%oR(qp Q9ik<*H*I}IjErę,7ParNOdW'`•&VI}'P /am='] =hu 鳿֯e=wX ;Yq 4.CK)L^)LYliA|c_A.ʉ e aTutH񺵭u: le#گ3`^v= PY//1Sl :`ձc80ɻ klrxWqEw9%UU(s ,³`1s)Cv3f?nh2R2aB7sKݵ瘬.r]!is|S49][9[eGXQFLѬr`:6oz5uFL 3 G]'~"INL_*<<VtwD]bI\5Ⱦz#Tqd \:Ǜ$'^r!2|ܹ1_iC-<ɓឡPob v(#2C_]y}n$[‚u<Ylmh=8^t=+C.L#2WFriBā<ݝj6z2^T٘dg\'n5<Dw"pSVAR2yuP qSU60rH̗̅?#4SYӺX.S$9l.VREeo퇃\a<:0 -Z-.4.)aU,OpJ+$IF[X-9gS|vۮ٥zsxGG^'LgB^h!eI&Qz .Lb}r/!Kgo<3rK`66gQ>5r-:*M3/88;mK|ws~xP 0_u.6eȲտF,aާfi!G:qF[W<"Eъސ$4_=4rwAMN¯e+57)Dڻ"DJe(Hj۶uBښ=Z?eM{b4o8I1Lj~:&U$mit8LqH.lbaؼ'H-rf:T3d)2*Jthzklhf^sD޶0/+}`h;Zw*yRei:$s@ܸcֺB+Ck'0pYa=ߟ}E^s%AW-܌iY&!ϩ׶͠KRYLm];SoF,o)s9D(\ &>=.@3Wxcbt.IF$UBN,{%!I$*uwbN}0BĨ;%a6Dvf̌C4=3Fot@_:I{S|gM ~´><#)2S8WE#vLI*Ͳ*3xHqRn}ܙ⥴$ ƍ,4.G 7c 9n9$ݐyXQ]LM!Y S8 (m' DY8ʢy%pg `U ]$l2S&$l.j0c:D68q L;gczꬋz+0up< 帕`H]LG7dW+Ơ)^r*&x -h}78y.z1A}D!ҹ<|I,DWԎA#5z!2W1㗇*Ih鑵Jsx~XilsH90͑/15eֿ 7*W*#WP7d_˟ɏ+zNicU9Pd ]d"wҭz@n =5Bq͠`69ȫz4ie/3IV|ЖaªA=Ϯ|1[Ͻe8Z^->a$ZoכVu-A:-E2]j U8 ѨJB+,(;Dz\,lFl:(UⵡLtb 4pZpG#6?۴9j ^C'm)2u/seX%UL1\/wӼLs{bwZ!,3k+^$e^zC `csC{~#s  Nz>,N*wUf% _AQpU~$EX1z`*EWqR?}uޱ9[8T3ٲ !\&*<%%,4WUp#TmW%\Mx!_Mҝ؄^BqӨǾPշ3CСSJE4K ҌR+"ߵ/#&Gc~<5(McOZ_pʪ]{I<ݢ/ D Vr=-7^':u'8^i̖YqabqQ74ՆҼǏAy_y@5#k' kxmѲuYyBs;\KC˅ 3%y[?7bj'Z2D!m?^}p&[":xulY"CSD%:hXR(ɺ(9y&0޴1wWiY\`k8g~@klt42.wP?rKL'yC5bZD+7nY6SP>&*o~NQ'A3WWd""^lB#Z7 \+6SqV㽽8vAM\8G{t]%q9>ЋJ2RX2J߀mVINaBbmkA໗S(VWBp:#l:Yƅ2-{VNRs /$psVK{. N_™@q CeEt$ *br?Ӳg. 1=#&Cg伋y\'gI< rD-Ps4pqTHݺ{9\ӂ@2YWLvGN`̣]!Q#PI6<'n6/KnDEͭf@>QNȋuk,/9ȈJ;ժrՈ42 ¬1G=g60>ݸXX2Ƣ+Cx 0:,9(l ˔q?׃vcKa h 139`N< @`q]̯f _ШȪx SHZ\6b&5F[ <ɣmmNv8Jީ7xv0{,?zY[)H7E:x|J?"4=ȚoF;ViVM?^:7b0׉#_n޺H_.%!"{-%% Jh%[t79 \^A٥ 6o +Udt[7eTE)Y澩`rBccKPri"coH)rxTʜ:ٳw/myE3>q*qTU\m˼vX P"8PL ˀJÞYfQ(z0BGԱ0@'5t^8uG)IXnT7Yߋp#XbzaRUZ,P5 'qDtF)G@}/p "}Q O5쨿.c'mGHhx3#['!# E99?k ?٣DE~^n}㎼h dג w}[ (zQdĔMcG#N8ԩ!'~0a}|lX8c̦U*]{R`!J$|}WFo֨^$_=F_ECjH_ h]p-f|ziLQT5Z(/Ag**drsRf,#?a0,{HNm"ѩ3BUM1 ' 76eh#2:, qå_^jMRDw]Mmw( vJp{q!T 5./?JiJW&H^FoѮMV:ӱ̻'+[jfVi3GyCښXXGib?h:%.}AOӄ=e!9U(YjSRY#Lig9uԟ f 3^7E6{2J[pElҵ-J(mQ״4m1/Q[ 9@GyY#?a  j㹃$Qk9,s8|`ҩ!ҿ-ILBP9ӂT]졤+m@V}O8w!{PO37J!x 3@b!U#Xui)b j>ѻ3Dmȗ3WS­VÇho.q+q<[“isc~]6mA'd5Πu-Jz~E9֟lBOtS6sdZac+ʗFOIҽ)kj˱qZE3foaׅC۞'RBOϑl,_.tpAHPJ_$(Č's9ϓ&v|MAǀO&Ý9zSe&XX%ÈWq9`JlPHL~^}c{CٓyE0x\)0k3^ڸKd)Yh} Q=ߑo֢hȩо/Ʈ4h+8%ɦ 䁺X kNl$atsĎޠl9 {#FWK2hyBX'oyHhg]_zDoT$~cGdid_]*e}nP+fĹ{ݞH/[YXI, bDyMڰn(T{ Gkwm&Fn["jsKSyVRO=~I}>S hvˇ n~= YwEgOB_F1%!kU5 mrt—FK7SeGmi0FZt|wSKMT+2!$LG&T3{d3b̹Fi整,+qWj$M>yI1`p q]ĉ1:_+4n?͗S \)3+2|aTLBj%x BD:ib sD 0:dˡכm)}7%8k1U86(L,<ǗiP`u^57$k|1f/XXѬ{ف-*Ԗ8^چK祕-佖+RKõt+C[rFB}]!e ( ^zAȜLQzZ}U0s'n LToi;rA7{7|N®Ju[} vn4U=M@(d~c-OWV>,d^%>.lg0ϛyKt64 Kfi~/9TVG3;RY#d44Īd S05qVQ|p3ې$ 3R"` ӫ )^7iUŨ`i˹~I~#$aִ>F)%ž\f*i^/-!PG.EG X9@!,pF€zH18@#- R L!o6 ^WKaOYj?VƤa]9S7b;l|{J2l\V4hKُ68aNfF@6 Ӥ>6ki_f,5f EcF@ _C!!ߞ4yFBnj=s|gЦhNo՚p⟤3b(餃Vn b% 1X5vh1w}<3G`nd< KD&W1쫦cT>;82E#RIiO6]>vm&j0M$idl,c| | ,B¬|{^11Z|"! Վn26p +06bѤ ")m㾯:@c\OY`>;MhroҴUܭj=L?'dRg~ =k!0-髈Y?>~W1g&'9d?RxEū\s|Pr;(Տwi,t?_"b]*vceo*iV&ĿWĮXESa"AT$_FWxT!0B&)NWwKM$lul&m4O\_Tm7`ΠN)쇼ʩRڟa t4m~%3_[\ HmܰJhqF%)>-~s3a ;S\Qy=LJ|*|ُ7ʩęc4/.ߕIUqX4s 8}*ٽV.HoBffEaW$_jIK ѹoQB)pwdb\6Z"A8v]Yӝٝ^+_#-eCw眣cKF3fAgӟb^fj`lJSEٯ; $x1%4[g"{Ӽ>=l"uwVsPBrBp)h||u:Jam[E@s(Fyr'x?|=*y8GUkׄ#\{=1h,5w@ ]=Q`s<eFو,?CG i82 {,EXCL֊U;]JjNG 0%PE@!QU~޴%N=O7V?x {V~hєŬѓ_58 ݲ/$ʤ3dH3 mEt`?|!Ug-·_l0ZE{5yN." G4o? 7!I@~41jUϻQI2X8,ȪzWo{i ROͫ`4Be +~͈Ȩ(a^ f]" 4fݻ8Zbvw)8O1Pfyb% l>8bj':,Y蜵L? H!*NQ/nlp~nOu:#&@xU]FoAtG#G;竣 yǔZ.(}P;hmc&"S/})!i+GPRdeq`xh>Tc.˷HһDڴ]!_,idpϽHP0,I ȃf B g@jLs-y.;s2*HHy@Ŭ<9Y$2-ILUSB85Ú0*$r5x*qG_JzϋtuQ;׏AV:HaڇRh[\Fr-[n+ּؕX/="?]գZ ~<7],6LLhZQ`lP,'9%qQӣ\^uiJ&ʖD;r;[z9{ܠ50ݠ"L;@KܒYQACzUWѝۏ?H\ {_n`2iE*dxv`ѓ2ٲݽkGYkTcW?H,8[y6;IZi |8=}ý-*T l:3n0Mu)WHJiZB?"n{vD͎dۆz>]b aqIe2I lBb5?\}m [^7t\Fg%5rMglG䭋U3'?hn7fy+K.[X]f^I// _IrP%v@Sǟ9eSy)/9?'y?ZC*OP\ކjРNSX91&[dScw1yޯMQZKiO^ uXۜ ;3̋HL !VOYtrl+|зv苰_eك^xw?/5-{l_+<Aqg&`?N)H *ڶpHgF@ct\ ns$YwjJLB$x3N/ұ)4Cԥ;>Tap<#o03{#g; $1>y]~@5C>Kgu̇cơƖre*i\jYKyB˵5Z|PF EvNWP,ƩFL06burU*?/kRއYԑ\fOyڌ4.M7\q^y3Sw$EJ3"WзtyCT NL,uӫqSD#ɏ`ܜEʉj.|0KRd^$RFԣ.#nz6 Zėx"c+y!K2KIOtre?;t" XSjDVvr⍉@g%|0_>=Lԥд!L{/~u~V|tk\/%?(UzѐtS4#|_c9O'(eJ jJ^&+rA_+Z`Z%N)5V&: @45doN+5ŸvCAd\CRd̗LglLH% `8ŏ1C@}*}rR o wK=)yJ7 !L{Bh-7&-ѡiBx9_vPUBT=T/2)ot,d,C848lk~AQ.StHf0fr򏝀\KJBԃD`y,uCDyO4-c?;}>|(KA@۩!%{4f;5Yn8D!Fi{7fӈE@Fu]yWoۛ^ub!vT9-a̷l|86~B9zv9̐e2T2 saKYZC#U_juFM z$5c< un נWRDv_`  0 #K ckt|Q[8n("EQ񏺔Dh\`EoOC\7MF5uGb ܢ%+ D_7L yW %I:Ӹo۴Dݽ~)(8N +:pa䓈h@76 qu@ANdh5h%dN84EKQ2;V*p$I 7'sL~~Ϙ8OԶ[~ψEO& GRg:B{VT׭47kcڳN! `[àۊqPajE!nlt'hFd8QlO0> eTdJ!NU+kО!B׮fva.z<1콗JÈXAd1o^G9F%dR:I]qNf(K.֮7,.%zhP%KFv6C*Eq((>R` #/bf Z>Yn4DE9LPVh~^fuӟ!$m锌8vT5W[S ;c&!9KӗU$*Fֆ!jvxXAu3%1WbGYeNA,`4h}а7% )zŏƽumaC;EPuj<:gJ 9`% 8^+8qCHkwYL%!i9<BƒcQ!̆^>AAszamN1s-` k_qYN|M]zhQB>HֶE?&i:D',4T˴*Vj'u:E{LeO7_ظX($ !s%ZJ9oRA+FP~t퐝*QQ(vX[t8Vi.*/ҹ {僚a=]#yZ$0½q?E A;?ݝ恧[~Dge;8Φ.5c1V:rPؐgBzx,!\#(ȵd%R6 ([ 6oN螜muA֌6dT,h  |s(SP`}ghچeI TCNu[1$apx\}ai=mմ (r2OgZc|l隱1@Xt<I+GSS_ !-&dAu]i1 1i>0-%ÂOD'E Q8 41W#ev2`N6i4PnϤN7Ewgev)xcىpIk3PkF;"jat~qhGtU>d.N2oty["#+4u !$EbkE[$-k"G%tA3D4&_]ޣ^n߻;ex~7!0ŋ* PkB~v Gs19+|$Y .$麐{B.f~|lX̀`koYijGBQZ M/@tVŽ͒(n h%`< ZFV>x/TѤLM{0l]bY>ӅӴW]=9]^oPBT?*k~V%/ E%f]sP;)z 1/ozL[TBQ/:b>YHKa#_==jQkGOwE:UhL 12d>:r;j`Dе=HaU%o#h":.|!WtY1`o֪Dۛ}VZM.55QGB{PVY='$ܒ|bRTc>}^0m\ Z I-.0͍ PuCH ;#20-+ޡ5ʍMք0RH n_חxX-of*J}<hx. YK@eĨY,Q7(W3 =kw%jc2탕lnWiFr(/Gpϩ#`LQlʷ <e{D*ۍTB0{+o8EzRaհfP·@{ʮ'0~[ d\"nU4P?B1iBf-5}Ѵtԯg/l8h&ʺu6Zo5 X NTE=o&HXod =sGat"$YFY0s}!ZH"8T?`K'o az $vQ}uaˊ~Vvxݤ #2'KKi(>e 'mSĴ4ȎPWn{JzS`|:|CtJOeȮG蠭I!J^eŠ Ùx9Xe pc*G! j~5oFo,te|ESd?SK] ~9n=C6P0y<w(Ma/3M*{ 6|ʌ$EpOg@V)dw%7'>؃!^*O?cbfUlN!v+I>%aIHIw%?? OL:3nkxf)k6ӽvJGh9ڹ'Z~N|OZpte7]du@3Vn;@G-iҔ5lTsݽ!cƹܔufXPfVHv `i壢s Il Ke_L]8:;Y2K>_t"<9oZ'*AͫtMM 1Q$һ)3Ϟ?e`bjeh>}vMfܢ Ѭ%`L .˕g\&Ov6 z/;.kH*MJ@2m% zzIuCD3 EAdt6MZ#7|,2,tcUP9VEa7( hA-H%"kŭe5<@}G,zV~Zޮ`vǽO&~N.. 20&jAe#OL: <0f߯mcQ񗁯gqE ƛ.!oQ)9g&M2v)㯻ugNoM俭=P9}[`"S"al􍇏 cﲎ%Iۭ$37_}UZ6?ENl^s?Zdј/ϑHv}eGg&a4J_&vHc?,#jp0C'ˣb} Ϧ!QAȁ cc<>!kUCך!fEJ3{,v)r0JY4&_Rd ih 㑆(Z:/W&7+?'?#m{K3y D\ h%Gi{)O}S*P,s0 !wazaf~IԈ9#(*qngYBLj=oVDSu{i?5ۉVOEӂ0 2:/DfkAg8Nv;W"{pgPt%~ئ4nb; Q_ǻ1c OFE;NWh1DĦ`Bq.Nǭ a9..hw$*#f2)dr.T xk*SJ IR sh uKl-m^I& &.VrÀISu-mV> nMn҆J|j$:mx'IiEo-P&v(/uWGR#jMR@st^ňLҸhhc;P n6DЀ]N sCHYkm.y4-0ac̔Nr]!/>p-4)DAxC:S sXNg*9+y ҳ j@EksaMn.]OI_I!]8E9ka@$w5m.saW MJYtш!돻1y;96ϑd7- {nkޔs(XPl*N]"Ax옏 @!y捕Wa6@wdA>&.ԚbkXu臹me_5! y5>$,D\j8 .|; ZW2T%FTO,Ա)2k2"nҰbc ϡ?^L "S#u[8[=229hTigF4FqNre=Y㓎;NLWنu9Y;x-/t õˈ-;GpեԱ}%qT{iUvS::Bls?ŁlI$/YSqM3WexI1~m̡sϜ E ߣ6̓_\4\G0n7DsH"{BУ~H/O]6j,;05۫5)#}{X?'D7& Ip-=[d{=w#_H =X(gf̈́KR`fbe*G hDF+\Ϥ%Z (PtB(pYPmlgl& k|فR j|zS:SFw0}8Ne^ihyҰUXhPXvFIc79G?Ηl:AӯGރC$)#EFP,JdwmAH6Q5o$V-LT]?/仪=qe0i@M&C֞Bkd̵*5Sӊyf>˯VؙcN5Qʶ+Ѭ1܀qL,+U #` -6wKlsPK~WH!?=y{LA_͡MMlB_pLl(tQ_Kݿu$e6vLnV7tMؖ0j|Q ! mט1I1iUzG8`F]b Uw-TQ K%p'B1-o6L DrP#a֕-,0H\V&-L;s˄eE6QRI`^Q.r- Gu| uz,o5qc]\ Tg7.C"J0نR/#X  v)<|Z?XD+y!_~(n,ja]OPqGGL=fC/ :/*Fɖ/} 4{S$# yN;e EQ8e'MbqܖF&, nh$QғoF3a_5n]ۖmI*RXouai5`c{a "wt-:'=7Fӕ>4}!~Igx))\ōW-/Tǥ4'j<hW-ܥĜclw ^uA0r R_zG`%?AR뇜HdB;GeO/8U ZT|yE8nպ:-- ((hE.DxwpWO:-0._ZkY! xXlwUO7=r+cqB0Uȫ"KS^;{XuN#Z0Z [MZ5)]GPPPJ}A~{b7I$$-0wOeСݜi]lf` HӀ wg{lsxcHgV!=n z#Y:Jf>X~g푾е]zA MMtJhV# Τ~aحԀ#J:[aAnF& R3<ܾk\3QE%+Ӱ['c#fuF #㏷Kد:yH"0NIAmϿN4ԂEZ=N- Ry!ݑK?f&IT 𕊙O Ӧ Oo>jd1BHs8OrT:ŷ@T`n%nRS`:#TkBG9*V^s>3kf7L~7Ŵ<]c0WpTghxeTpG7}tnҒwtNxKr8i~RqW̚1_vu N\Cf~&Z5:4ʡ~ v F*Be^%b:a %@RƂyAv>3ճsЫ> ՚r{ayO Ώ.+@x * n[+x¨2[6՘dVT g02\RqIy22l!S`GEC$]q*Q"05Kؾ mt FKQ+:2q^4F~4#C 'g?^$$Ac:W~7븯е|Vs')f~[O_\; Y9uR)(=%/+@hJAbҤq#ake NL3y*%&_ݾ#_J-$.f.i(A-,!t9>{i.JoYM ^sʝ R\CpڪDI, *{n@Rq6]O]gCx\'sH ZZ]$A9/Sݒ# ݩesL۷]3IK5'vwII5NQMo*Q?ʣMk XX¥]ѓX~YŚǍGh"\;dt SI]7e"E;E 'T4+]1E-n@Vsި>lMlByxXQiM\%XF $$'QmYm`MfόI2$9?_2j%P ?UlxK!ey"& _!^~Tz7/\bh7tԶD{h9_El"|䡊Ya<a' z.'嫘,P&\U8~&A]TV̊83Iicjbs&?2٘zK((A[R27dˆci;gFd 4?ƣ+I?yĎ5=!gUHPM w5_Q?@Xg?/W^=:|IOM;3X;O~hrԓ9f!M9: :Q,ăՎrylvAm{Y.w媉o҄iI:Ee܀(n߮A?JdN3@\IyIA}Pd0==iR"]uf@˜DCךҦ9,w*L[L7hydz0 ʓ릆Sh 71NOlͤn; D\/ 9[aTk0NJGT/\ǤQGL2z%U3NOUh'7t6ɸC2ǽCj3pEbFxC%hgzʇI@ATwA' V76.ut0J\CuclԾ#W\ J@E1%xB7,V\Jx'gzߦAxƏM?{g@jQ u%~({̀Y*Xu12vFL+8-wߵV̙;@7 kRu$sz X(h8Nmu/'J]'u0aŅjRE1hM{F:²u!tԞ|aO6ϒū#I&n F{$"ӗz0@-{gum0p@9zzn1 nZ̬ 'C>CK$, #_LCþ8)BKQS^\F?Nǃ^o#{WW2.z9 ?x2 +\8simrOWVWcSky%lO6N(:@;;=r.G"pSm{ VJWIa/E3)/y|,K})Rfld_@=Fq2mIL%RըowD_NjCAq.B52jlhu?c?FbDŽg>m^@8"y0qje?E__8\. +ߡАXc*1LmyD38ǟ`7'Ą |nw(Ԩ{1H﹯Uh*)6VsPdl lAU-/=0܈"(bJs{pa}mu,?$9Ztz7:Uy+u䘾|T?օ;&C@0+޷m1UfʡKRs`r"lZ:3 *f+ZVp Y hYjLm7ps!w~W7?Wjj%N7}TXDg>aYۺU0gq7uMS-v:-_3-nVwO2tŻLm Аؗ D#PFW ӕâ.'V+Cq{'9&mak-'6#m[.~W6 J{ Ik.KzO UK])|17qJD N[{4Q_*ҫ9jGڦӪ_:f]4v/ CwE|q;]X-,0c&Pܦ>,P\z֋YD.DP F1\ #\yPk(L:9YTg2؛1$&ƸFPX};zoI 󐧤`'"3[0k/\ 9 U{f~*yR!+Yd|ImN"5_ثT}% 9@L!7Qj'>`N&8HZ8u''~!_2;=̤^T^뼷c;M5= :~[Ch`J8#i,nHbI66l! [}xQik|a#㑞jx{0a@dN^܀R Bengqvuկ`DIa$0>=D (Q~q7z~܌Ftti'.("[a !yCȞ=h} r# 4/]9X9*Aavg ³}{mI'[|cd q[^Ho&"ҝqRkʜ漵lW2yos) Bm}9&Y8]WKud$<5^n!>6#p(E43hr21}4̍ec +x1 mXEҪMnwSc,s= ?|fdYpگsHD}qg0\YvftWׇFI$!=#`--`,@zu< >9)e`12z%>l,^{Vu7z56=XQm`iK0 /Ʋb7HkPT#U{f4j {Z }p)9ćàndMڂ 2*pݸW~U ? Cơ0`Z;2<::KG29TNq]]lJp49ޤ_kٕs.ֵΜ!Qf ˀ7"gxr$xzehVY%e5XBQ~Jy$!Jަ3F9$b>g:D06rPB&d]A p-BB%2̥QY] t ǀ&vU]U9= 0zb1PFu ;tċkL5`mЎD~͋, (-eG4-פiaa`rTp'Vlj~-%+(ۃ3{EY8c,Xnh hTTlJl`lN3rJ7UDcã=]^D>6r{ˮ+ٞ.i8*%8.&eEk uu|`ʣ`"O7ӊA]H\wf`9 qZTvdB,VN.xr_.=kt#5u*>tοX[uOn5' A$[lj ڂ%7os]xo&< "ᦴ鸢(eN&u2'fmBѨ)A? RoN piSN XpFVO{-\h0"cv o2spcjx&_r{BSovC #ۜ0xkή;%z rP揀 FWNX-V6E.VCk{g8un1{bjIaM{~n1A?ϽImYM"?ȱ= ?VKW[D|EIV{ePbՉee{O;׸o.U 8*p{巬!0zbEr*wmqxϽJuPi jaÇRR9b@Rsزp;ѡSpeDdT[0TMeۍ(Wla]haJP=N9!Aff6mq'N 7O(]cBoܜi8z#x]SbްV.r@*'#jYٜu"M{MaU(/ c$fE9G*uZgan_DfZ4rM=LAxߢf' b҂=w[XNHv9%}ӰC[28@*d҅=5MDt4T(*m]90\K+*!Z[5U5;>#A%re 6Rg>3gER- K&-"**^{&X&ǒڜgj*DFfB \R6ZQJ Vk+YѤ 5aCK" xÏN&E*=U7O1q%PS6%>0 YZgraph/data/integrinMediatedCellAdhesion.rda0000644000175000017500000000535714136046755020662 0ustar nileshnilesh\[l\G>{ήR5֤k;u˥gvl7NZ(/=jw4yH&/HK*U!h4H} q{JP̙?챽c;مt<3sLT0 0mBѸ ?\vWuW 3Q-(ҏQ\g'@pӅ /qbFfC2 ⼧ ,?vZ^k+9UTRޯjHJ*p0 Qb=Q$Nc4<]CMj >F\Q51UXUnti]U{HŚ7%E29*Ҫ9PmEۘ'GT%+(+gTYUZ-&Օk%-gJpJL3j)e;ۙU5j1irUk+.ivIvu7^m^=6RENFc[8[*/vwMHcD {,& tTh0椀818sF!D=qoc4,}l\4LsGAE=Y&'|I (n{%=b؃|mcy@h`AFXIL O E IAs7L0 4mŅ#t еa j).Lo)b@`U i/"嗘5JI(1IX'?_l(NI: '&gmh %hr<*qpL 3=Dq"oM yKKj 9&C1nyrd->.wcٿ3oˎ>Bd7'ro@Q.եP wm&.3^w`"PIM^,7JVi1 j{Q^o|^{y=ʹ H?4$\q hi/<-/uvҐ|m&/^oUd&^)ӯ~S_+:_$m\x/ӐVky(JD_÷$ >ez)׾-_L ~:.~Ҧs6+p?];H?I{I|.=G/y}R $y)9_$}[!H'' <0OiXd:>ǹswGaYO[<8DCӐesH vw4hcɘ4u%BZ;CАhk=9uGkbF,CbtnѢ,"M[3"Ubg_9z )%B*Xg8ܞ;r^{֣(}zf >ю8L)7C4b*u]:Bc4)S:Ay'eZvTZnr zn>)xR8m <S<ƻkӾ%En@ڈ4XxW 6MV`@ϻtdxLy* n;#Y*?wEtRAy; c-0#8#::g .(J{s_dO0),<solDy?DkiN͠>vR!)ƶ/!Ñ6<lX*H 0\o#>\<9Ѯ?HHHHұFjFv&;~s_2^^·(7AtV !BWMc@-XBR۔u=Ow޹,ouU9~xoH#'xeۤ.ݢM*ˌ mFgv04=MKlξҳWxguPO[&$aV\m+f ,`7W?3=WnGWsgraph/data/esetsMale.rda0000644000175000017500000016027014136046755015051 0ustar nileshnilesh7zXZi"6!X|])TW"nRʟXaqjnj-' ;Qˬ:r]S2]:\..I ff5=6rV`+()UdETEF 2gx+T:b_Yᐁ[}Z>"7r1+u^{IVw'06r+1 ^cӝÚ_Aj,b:Ƨ_ th5nU vkʰ%R !HO9ڑ}kyp6Ǜ. +:52U26`暬:Qw ge3ZqD̩rT} nx,_3#>SNN\:-&{QGi(ɡr/"؅ִit{ì)4x)X>+AsvF=E(=2ӽ"N&â&o܆Fw~vDF§W&|%egHR7B$+@Td{u"GA_7 t<4g]C֒^ XŲo*bKɜbŶ]_%Wcm\ #q>#:P'Z%iԗ8G%d}a~S88OJgFd])}Z>BDl̗N]X|ۙ‚:I6CqUTjq S>P,*Riҍ&%mA ťG9PMlʥ+b4}Y~d3{Q bnR:ɅEGgwߓ ✭Žk,X_E<`6ܢM~<=gT@EǴm@* ;*UE1"JXۡfobC7gb:R3ƙ/GՆ!EliB9M22]9K[Z0׀Ov(1| vͰIʩJ0KЌaj bހ[jr<.Uiifu8$m8{]0St#f}Jj:0ژ ?=\i&rԥWK4ݽpy %7kHfK9d+A:!%`:?tN98P0w#h| vo\k&"zbFp|Sb#U 2s_xYŏm"#MN ĠM'e[rMF2u -L0HvJw'C* s^-eG#TNr|F;+=^8?6~DWgSҒY+ `q2fc(O+ H=r|-ms:YRΝi$ 0_g}|IW⯋E\>"%M^W*NvN jA~BwA`W2Μ8#D5fěPE(F\!u[bc/W߿mEsŘ2~ sg^7E N)CRr"eP YUr@P͐--LӴlC`o D W^&. dNry,5Zu,,ygq*pXdB1㤍ԞG- \ϝI$Tb53]nd=錑@_Zѕko#ݠOs%_؝)(i5I9esFw5jz~ZT9J>a2,ұl;c_beP^f c{7e\2h5p3Pk/c.ȯrJ(TڵIFWIsxF\j(ş،xMM{j.g7eA;΂>{P r5B,J0͙e6У_ċrg S*hj1ypm,rU/2a!BTa[&>3E T3ywq6N,L 50̆Cf5,`%a/VWh_:bvوklޥ)~ Jq+ 1fNd1NBCIN+&0EI z p[ M|ϨE u`~zW ƒ S+`RCC jP߲ʷ}#LpݳÈ=j Kݩ~3U5i"BIkk&ն$H#5JcP,@A41" bծNd;[6C?p4D~.I A[j&#N] 1'dlh9 4f|ТjcM' "3#e!#:Ȉ{Tkeq|ΚDZVoҔ8C7ruĐ3D5L=}7&K9ӻVo6,=ϯMVJegay>vMlkPsoI:u5j,7^QO`08>Y:lLDzemA{^-PLbo-/~*W<Z95uB^bFۛ(ӶRc~݌2~M)7ɆqUCq2'ȭ̤jJ ʹboĩ2m?m9vJ=GSz ^Nt{ |`zyuv?[ '<|x:qY>:6:HBVPT(fqލy T աAj"!!pxzz"=X^%LLU(d ,ӕ peD7p9`*u $X0v)*n's--FW^\W^Wq*C6()~9TMR3gloM"ϤjՁ6gpU" I8Q[gdEÙHq#ԓP=-# aINӹrV!b`A 6l^K&,%^ꎾWqt, \hxi=hBK( 7%a iDS:s$AqK8ڲP㳐c&BljiQJ9̤_ V Ѻ'wIgp}]6pKeSnZod3.c5J&ga!n1Fˌjɷe(Zk8g|!w1ebneM*BDIƽDf|Y? *r)L>{BFܪa:څzlN4 o?kI%lK]wܓ="zX[UPc3 }7=.D%4BqfA{T}\v om˥ql2| (4l٭_3=C҂bB@e ܪ :tKW@vaU(n/c3(0:V;y $`qE8CRG5c :nMg_]&m=mxk+[l)|4"z/H~O֎;Da]o,͢pEM31kQ۪}=75l~m:ݬu`4|UHV (jꬒ{7ru"%5}!$##^ hN^XW(JfCkM`jv4+^ۂfmanh7d.3~Z[O\>;8IzASY.^m zΞԀV]LxVLhmh#lFZ;.Ҩ_o?`|K"Tmn,E` >n\xqQ/(tō!^ Nz-VP]~Ы\6-Abu# |Q+mƎ+1AifQەɪ DQ=ݣӨm9qE#aSvOi%!n\D!9cj^fy$P*DҴ6,czS~;#&ul1;P7ƚ~< Ʊ=Gz];!NaeI (MFP:qtbu-Y9±R@:ƣcv%Uq0\A&:28(Btr:1t.i bbV쥵2M\~0, =c9߫fekR?={%pI+ TEV>C_g%|&P&|V!޼4p>P |R_B$^!2eOuqƅF5eVt7B=6G~{G<^Z0NSx;QtQ1$V} f#^io8h)ymc9!?]_HR%$ %iN}( [Mqd{Z >\=jԾ''Z4%f&-| Ѹ9h\kD7/7<8@7<`&(G| hy&pRO-!!0mK2pӭR8t揵rDzzZ?U)IgxdlHR,1bxW-dmmg.jG~+N)N7O8, dE2UGC1sIamgs߱lDSI>KvYMrsP[yߧ<'>t{Zm[CE %<ȂcwRLr$W\ }$M " @ov8.Y4+P;.xtc;/ަ$3I}# !ۣh鎢|.TkoɐQէ%zP(Vmf ,Lbڢwݴt M$"tքre>m0# "l. ޏiM%SD6'!AA-n^՚VہMRY>t騄WfX9(HP'.&hcBr5NpV'$ʷ:wv "Թ־9-|~NISರ[nݎ>G2띷*0ܧkQoLP!bd%]T0j-Eޱ(yP{B[pbj#;-6'aI:NJKEC*46L[4R)-$&6 \u*^aT.K:fÍU0jsZYԕh?,iD:1Ǘ{7 $47v_6>f-v+#MBYI}js L̉1dE†yPwl[wȸ*b|ձ?6XcB@Z֤;jbNFf@>N+ה1ԈTizx0VyӄCmHrY2'D:Ɛf?~0}Ieq? |[7~l.~'r&8Wu28luCT'nv몃3iNy極KMb_A v m&55MGԧx2~nEQzp«;iH2\KAF6n#+iK/h5jP؏rA2c{.l~45wۈp"nDkSDbSАJALاKF@6<'HaF2mY.yQ4`Qb[N~G[!%4,g<]ӊZ,lkq.(>Fs›@eLi[[ipx2Z+'jV́5ugM {8&;צp\+qIo@! #x4i+ G;(8ȺM aZAü]q0O?jp?ȥXr&9?42"2^ʗ hôF~0)CYS $\C^NYӯW]CPwO $n$Wc zC˳ 8 VN) 7ʽQ1,tϒElǮSfC/1wW-H?wX΀M!>JΓJ,)>`b)`)#Win"O>+?UUUʆv\=)ER`˺@sܿh.ŋja۳"t5Dl1pTnB6Q8K}Jx dNF-;bZ# #C+s'/ڶlJ9;`_2U8ۖ f&n#^uȟwd"- L|RLā"v: BՇv->Og$ݾHѴVH.ة!@M!҇b L $~S?qUgv0Smה?{>| ~tG*88{t tHʫgangGf3%AKc-zsZ,U- N7Wr-&h}Ez(TLi h,͒2}ЧMBlQb#%zdW55;Y:0^dL~O*w2dh<[cyMVF#Rs${LdV~=U0~7סqOJkdK4 nVMPZn}u١#\ƛ&΅mq5*V'9 5~i9xʅ7'`gs0S9w`+`2 DV7Pd}4 QRmydVi L7z3?:U"HCX2whg0]9MŮ47|qD7n\p4؃"6M橫X6zy{$RnAD}ízt)=Zh`rz3bc7F')DU%VG^׽T|PܲN*>Z{aDe4UB\2z4ѵ# D%[Xatz\24/s-~<x`.:s,noTLAV}%9 OY1qFnf#ܑ[wX;AQ%n+;7 J  ]P9 x쿖@4%%)wki#>r0寋Ix'uɣ4jGZ_Y+uts U}+C+돊,ػ=ۋrLq!y~ޔ (J'¤/ڷgyWwqmEDŽs?A3_os(C e5vf:"Q1r= H<j|(> -/F3LGYAեyz`@FB nw!j`ETt]4''>my+U[u<z>\vmr7 |^UiM\8ؚpg^#sfc_ S.*l皔vy MOXa::%t t)/se<uf#ҖtFm:2*9<=;*,u4$7=Q|, tu/8YCyZKXCآC}Th PӲKTޛB k1xƋZN`y~UDWC2BZE"äҏpyIAD$!R{',kmTP{NXwx#8 \SFCpg՞O48exͥӐÚKNsQNmy-MHs#X}wے`$,y#GUi]WI0ahrvFD0O  $g)HghXܳnYp $)+QjޣC`:y,j9LtBtP| cU$s*sy 9՞k6,L#ݏC5tɧ4b9β^,]|h-}}?P\',g:B^ZN&rc]SnL"E]7"d^R)tI(?8 mV4kv 45iX}(hgm@Nuk.;O^й[U2 2 ZޗkQhEoG*E:t/J&Uu߮~ ^_; ^q`$ rs›)9ȝ{ioȐSWRGg 8vCblucTSLvm}%* tG'ێ~M)PP6GT4@^Z 5bj¤\)j$&eՑ i5i.%7t*TSXi[r!md 113O_p]:?UK1 0 FW5ؠp*mL#|QkTϚU_K5cn<"aڹga"}~j7.uгklrJPMhxD [{vu@:;Y-Yyo!q.Lj`,iь!Oe?2Ht]NnkT;W?6f0 ft=[ Nwv'IN㵻0‚VN_"ot ;'LqiT<=OJBc6bF0Fʡюd`ۛ(. s.B[ւ mG%5ķS,dsNa,5}Xpz㑎6<0PG'PVm}'lcV^Hx{-e7>{LLTvƩ< h-1esOlrOigtm? 3MJagk4՚9zmN:\]< B~uWP0Y:uJd-&SȭY!3Em^:Z"(5Wg$Ak)ㆯ T`kٲϺrs[,[>rH O1wSLbH3tR5J4y!:9cUveJiOԇd=[qE-Y•-Q1x)@*cdU PS]W9B^V&lw> O-0Bhe]{w% IFkzéZtx|-y",~-)DF wj7sJoQhXŕœrl4Ћ_);)Jl']lA 50 "'f<)->'*# Foć𫊎u^e6|'OSY?R_T()Ly_=Ø{zՙxw-^2UJUv𩚥ԫAŭgzDt 4iQcD/?!'pjt7 z&T: i9tc!E)-}__'?ĄwQ纁(8Wϖ }qg˂N ­J{?SMˏU]n;pg,M@?Uu D7!Z>s/.gni dP%b忊ՔRXȾL G(8rOMa҆.t⧙oR&W΄VcKNc`N _ ΥWuGIj*ngW = E>l'_vHD "?4 DZ);ߙx5hc޸ByŏӉL k$ZO ouת2и^#ב2N6Ȝ{R0"9IQEg7nPif϶ c!C3C`)G/#ܥYZ*WRkx{S@_҆)U\85d@*;NƸQ~1s4 -C?EƓ\ 9{8;w%ɨvvv"- ˲3}:v(.ԅHR s3UoΆrҟiYG7?rR t /!z`D3@tq3::f/wjAB߃pzENk\u h=Tޖ ʨCj4Z%m_|NIG>`issw'qo; GC`sR"yxc%vB,4:cEE#{-9==-A-Osj*(J45vc#Wm22bMuvOkm66n7gIIlp< m[e :=)p#@AmCp!㶇ćʡ՚'z!]Ov4R,e( -Y2>br۰{4JyU|rapm$*~[p84/1]QC*bfO eJk͍8-Zi)+R)q@Z $4])6&vauT¡:4"򕋵_Wok)}*]l0/3o8btkv#H9=v`,x(NZ9Cf08 dݩ&zTq*쳥KY-=ٍ|Y"J~gu!R8V\Cz! Hb^92*S^,-|!HS[.J#C "EZx$PZR 5V/^Yi_Vh :4/lO'ÎhHYg#JP2|XGSAzi= sCҍS>U hC0~scW& ei=n2 D@U;2*`hwBz>S's9R=`. -'1l66eȽTB 4SSIՐ.h7!ǑcS0lTOԬQvbU!Kbnߦ+15Q"[V;)x`$)<W1֊#.Iڴba8!\M&M:HHq%`!ZMӲ3vۮ)lR<^VHHduM\MuϬIP2䩱|zu.?J)Qω(7;ԖOwЎJ*b+m)cbzɴR"(ct$!'A&&BX.GfkOm0B&!eJ38()uY]"?6J!*%dW\CݭzE:Ih -m}13$ӂ!sG0ѳ]IN3]D,]g̻~l񪗩f?osdw3B!;EQ1v|gAG x >,m᭕/;G__&H)`xvP?j4[da7|5\Jqs[KsR'œ>Ě%#6[Eh!4D 8fNȗXvoNpH*B wȏue wTOp=R%ZРޕJ&`Dt&{v37"㦆a O6N4nO58s!%? 8P1v^گU΂_JU9l4?:ridn#])V*Xo4\$ bVTA~݈Tn~R^(x$Ja嵙3 Džku ʚ{CgߝjӔXMp/<^ոϛzG摧zf1ѧK7}Xv^A0d(JlPY=?nJ5qz6v7Y#k;Y3pM c#w.O5$*j-,0_ ϭ~$bb0s8(^HHgrj&3}*'JtܒA"SC}G#1b5iL"q7E>{ jPAα\`΃nrŀ?jOέ+ㄻӶ!ehf.0$=L^W@v>ZB[Lb;FK[Ol6K j;:>(nDʎm*#xZHeN#C-1R{N`gHc_7wZ~9"=Q if|mC-)daOpvhC0sFf mgdQRw1㫣< b䤹X}-JREəp''0aҤqY<\8ECs5OFʈd:=աmL)jm5eٝH]28m D ɳr=ƀpe X! `QZ10B2LҕO,O~}jans)K2媒ƙVʴjn"TГR㖐@&r@Hr9 gEN4kտNʑE&ͩb!T*V.zKE2?G/N<)L) T 3ƮR uOIB!лo+Y=a}Ey6#OxY+7$gOZƕX?„5Ern{G͒!©'^πgU>W)ޟq:f3nA ޲B"8Wl$#͇{U:K|bS[dpXr D`#\W-l 0T@- GAwѿ8N+xkk7;1}5b*bH{ wB46fU }|< +5'B1lPôFmJox24fPKP'=Zn]eK )4 lq}v@bI Ce@3Q jYSor$rar@6&㙑.[.T Q}BaKelBTj8>"]o@43!)Y'kXlC.hcWJk:wjL7韈dL>޳QPrtv#LEY&/ߚ{VcO~i:\Sϖogf!'y%草oeW2~De;l噼3`: ,N 1{%O ~wuS8ߴԻdƎ' t&D;ISd$C6A Վ6UT _(ūP5wC4COJfLo! eK/.?="P}\i<'1i1~b<4- aglaO8ŸwA,'koʬJ&$y' u&\0?zK\Rd k +P[VUwWmA؜^[41 }{ki>+at6Z3!M|ҿuBEG+H&P28s𹭑^$Mf~jO ߴȁ0[E),)ʵ;sz&Io3CJRg=0r2c\<'\us,Kjۗ^JeZ;`,m) N.b;0]#"= 0%7"jH?'"Cɇns~6noP ޫ1idc1EMIfш QQhy,@Px=6Hķqsbf]ѼCm:duBeLſڶm&qY}mtA۰,AÝAg]NU*b_tqjw>~JbŞq|j$v7;!a(*rY ($8VFIC_>Yύxy]OL޹qUcz#]9%hs!HPEHdSҤ43~"&] | _4#1Ɲ37Fk%>x^BԸQL`u] Coy8ϱ#]r*T_[# "?|[Ryhhq. Yl9eHHJXdpV~+r!Ro k҄s3Bqv}oMm8U(d1|cV|Hl|cZy<39%Q0R,` ֛e9eL5n=N^A'yJ_LkiGŷ㜩1;gk:&nìGw$߲ vp"y.Y'NI_V,ΐ\B~RLD gC ,HLy&/%X{.0iJ%Y])*[8@QQQItAX Ԇ5ڮ>j>6Θk]Zּt31@4:;z?8LI7d!hK~` b4tf>,4ҾІ2mGsҚ(~V(url#r9}xzoOЙ 2;g.]k;v:\Y{ |@pld6R4l\oj*zLؤD5q1e:pg!&MB]IA{@Es XDEŔd֝BfI*'dI~PqNE#p5hգl4)=\ M@:NCPƢZ8x9rs<{:ӌH' sVr> mxepec6Z$wB j ?Y;1:l%`O ;[ - PtCBY%K6+OӵܺhMPTٹVLݼ/+iD yP19 ,"u ȥUmQ"k"|N5a[9#$csJc NBn6MK?l$t`)nlwU{u0[~9䍦PpV{K4/ &]RowzPl؆^p[1%X0O3W9!@p\0mͶezRCFWQ(0x;IC+.ok$445ڍ)yWڿM +7)V?fOWl^P<3x 0̑XI"9Cw^/~n8F~{섮GK_R6oqH-7/^/gcg yVFV 7oatIHF.䞑mUx j b)%G[kg˟uxWzM. ^GHS~KF2}){k>4A$n#`/RH1nhj(y5{8nՍ-u% y4\_-68*{%M D[e0\ڿ[,{6DtҸ-dT&$C𨐓}|G]1b'VWVضֽ+(t8FeXk%r *qYT|U )3*+-gY,9h>^TجU\:>2GI9|}p>TH=)e Z!Gǣ8v|%)~гuځ lGf 88D/`LzJb[M.?ZRMGfm֩a;`9PwNnW({Lz0qAORx;BqEI7+l>(+}cv3WKu0iF/[hL,ۯG;̐_L>Td}&7hNb/)Yb,Tt ?}G1d;I hQLCAڭS @ l(W K{1Kp0q]w x~ʘ[&5x<%G(|GWGȂ # ίd׵%DNSyaWف LT10zݽ{k!-$4g1abI @$YR(jw\K}jnKaX=lmzdQq`| <0K b?COBD <*ĸ5*v@$e08cv%`oKbl:IEYшHrQ+iR.K #foICozg?I90&ube(8L s -7HV(}7 D?ܜ>5+֭, J(|='l筂$ATA,뱾tfx Yk{6k|@y ÂL Z=@y,{@uVo jή^wXb@ vX_r'YvfSTиdJoŅX"?oHPNn3KL eC)^LK6us}-|57ͽF)oڮM(ث`x!8 h|E#X,jJ\zOXfK~pbmcYIV[$/];bGi re)u&07ӀM' ۣG߿(XJ$mj\ r6 z Ͷo 1BAP!nBsɱi[TF_792\O%iߴ=j=e!s,#.(3ZvPr/SSdkgO&UG/]L{ѣ{.EVRҹ&5-lZNd=T2&MG:pV!2I2蝇r?8Q{?+Ӈq%v7i&4H;S[`a#+5Nr;a1mnBޑ[彄zKP oۘB(_Jvpf3o`w N1|baCYP)n Qr-BG':x7}6V/ DF |U`9pB6οMUN Nppy -QwhCMw3uӻy9|hrmz5-ujv[[k @~}U]IUfWqnj].2N Q(i"t^?\?5 6DFa:\0kmaC SP58: y+ӍYJy}>"`ɶw67@_ׇ[yX}E+Sh`g!#F;? FTTe#]QWtЉ{k}bmהEYƗ UcS>MqX)ؖ~։mVUŶtOs\)T@)q(K z#ug7Ϳ^8`C.do67a)ԹE%u2FߊQ`b=ߡX> $8cr`D1cZ-hZ*AQ {^Gu-5X4Ů )T|RA1 [< CdHdT!Pf&sNjT>0l)8O>a %;<(>T&2 f(vOPw yP$9fllY{`PEoCihg}ݘ/=TXA~f̓&tE4;6 QcN}9^F6 (E#Q} /%x/cgU=.U%g>j|MUr1Nvx~, @ju|jhc ȉ#BGf+9Mا/z!GwvgBU*yN.2tCJWP?(k3љZs0)Jv+Q' 1mXNZ[nٝxw]:jIA[7:oN6Tu5{Kp=BVxQkBqbO{ t|؋廹RƁ)lE: btcE'MxUNťCz쨉hF-5ic@S'/\Ki T="t+xlŸ^,LbEB`:p5bP]yxBZNɽEfx'hKLMfF#CmD=S1hTU8 v_0[ %{WxdW^UfZL,&6 xq4H\E.EdA@gDp4"/bIUV&ʟnWCf0sVJ]b'i%Tp)? :KP@()0tA?sr֘IJxBQy_H `.B3h cѰ> zw&?\'҂x}4kZq[ic܉ZK"ލ8)H7tB(D6=K~&߭S=.!`}Z94Y'L|z.n.3]K󅩳GVWG{!%Aj)njJCA !8IKS"`9<_n^Y.~ @sw Ȓvyk,pKQj5ݵӂ=I`WNJd 4> ds:۹MvwCJH Y%A?$N''άydk8JQ2eh;\bә_A݂`pό9O%NbfoŌyQcYiWu}Y$<#DŽH͕L̛ܥ^]Uj^6W9!$l⏿,_1r5Y.]7s[3:LNi3KfW$kQmRYI`u 3C{o&l+#Ґ5r'rZ2v{4i~h7VY_`Z HuH6K$aњs$Ǚ;Y=A ${`}qW7$eÅ*Έtf EnB~|C&Vrd`[4rUQц)8P9Ijʝ?^WtFjAd9zI87j9GuVUA#6Ozd|J*=#?"`%hS>{VF׆.k^%7߃a.>ҙ⍶s?t`iƃRqmdr{=/* v+xg|Jү^ye&P5f8!t_d3{/AU¿Sp2}NefI?9PkOf%̏g@Zv<|  O`ADwFgcӒ<+;Pف~i/= 5MF4]=qǥ~& ~}sk+N^]ʮJ;%װl Af4`|FU+Xl D5?Gg8L4:.C^yo Gwes-љLx )y/h޺V_g86qJY ,]SSe22cꎜFЯIFUm\mMJrS [VUWg*wϷMr$[OWO*`kA cW^}&]Fb*(V8'\v3_48OWh-\R.~M85(ף/겙gC ~jsq q>!En ,U%һ$ ܔ@<Ƭ9%Gd聝FٻH,m`!RSzc~)|:7f|zEؿ0r8MR(5Z=xÉPT3驢=D_P㩈F܇0䩉*nǴ8SEj󽚚kFcd|j΃5d _<`!PH$I`0x9.4I~O^ FbP;ΊUcCQξñBkV0݉BuHaMtV>mTxq9IPay_EFCO \Mܞ;֜ewq^)"]7HQT:ZQ{s=F( jٵQQ~' eEGp\_x R\G|`44`=U$V#WuX lp?0N0k]#Bks)3R5wJ%s)F* 3 /0NmTW 4p@?.K")zwM7Ci> .tшXeƨi9:c^yyAA2,p06f!(7~Er%j |י|uwuɥ2]CTݥ3H{"kN]?HޛmY5"01;rSʾׄ5tzQ\U5!G,G63g Xpe,jUǔvlLBUsؗAy1re&眏 mH~VQDMe"}ƗNS_dA.Cܜ -_%h&#@"ltU$o&WR㬗'T{*09f B,Xv@Aϯ?]#m)\r-VU4/]#CM ,5;ANZX)ʧ*JO~]~/oeUggE^WQ F &+϶+3 NS2?P"8s98 {=4ʷGOusC48ڈa&(}Zn۷VZ"۟1V08S{|eyˮ{֫:(^!BрwY1HUcwV@G_]$cga~cnGumym+@i8Ö^2}IϢ嫍h4ፆoD˟bհB=!2>W!h;eZ g$}EIiI"I*&WcEa| zrzb7*|{Ph}T'7eYtnl04I:ަv@uTmX=!5jDmH/j%wqG' hCjEFtl~>lf(f d{[Ժ,Ѕ+AuN@Hlrr!+}fGYǓK nS\ *`| *;~Sgc9jn7(8ԸJ`^9F'y?,@l! ~?/hmu^3+qG\-V ;"r(ftgŨTAg^fᨾ˹G0:dTtH"-Gc>a"N )N3MpW y6IbӼ;n72ȵͰΪ(/Z6 *!Ġ_6Ã+ []}elihxNzI! dexC7^>'po"9$BN<>wT6H\LWap̼F"RG*tQBa{]Ȭݥ>_P:Qͦ2c]=-0i*fkXgWb" _9IJ>ĊK8jQm6j5[ NۼHyy]/${s?-h~\y2^+<|\F%ny(tﺸd:ťo-Ƀüq"/7.u8&Ʋ oDgOъdK#5ec%p5`[X BxV , TW, hCMֺBBluLp4TW}_߳[PN9x'L$rxȃ+bini-E, l2h53+y`́Jwr;5R ͖R"eW"MCDuy]jr3X1!ET1e}>jiRVJF^ Xzs.2ӠKOCgz+j{ ԑOGߺEn\D?oZPDbI0T6r֠+*<œ`'Rm Sb|AsJL7ϳ$!/!{CC>e *Mhh†aVِٖRg<ü43ƾRpV>\}\g6v/Ҡ_1@pPJEO5[Vѫ.s%{pyTT3JW׸"4Ƙ<;(,%SbSXLbQ̏7m@}W) =V,tIo %@ f0^lDe±WIAx<(Ww\:XQ6`GÀ&Rmu+΂IId4U2 G@JRI+Qcm,"sju2gz O|KpibM/ px\ 9󸉅[gEew9AgXf*{>"za:k5;M \[RJ\7ؿά^ 4qsD6uouѨBև+&B8vPE<~(7inH _&3 `f/=e.}|8Yl\~pmtuAC_ fw"~4?(Tz2ZC0}9& ׃Q! i`{(M}KFn,IW]4!k8yTeO +Ш *J Ǜ-P0Cu#50uCZg0D򀇋L/2DŽ?RN \qpMi^WfcW] !;#n(xU/cǽ4Y;&lnȜu/*ْHo< ;xIWHpڶ'-8>vr0j>ƾDߣC.>s*F  UU}1= `YU$gF0ԻOJU~^Pmqm:oUt!!qm~W^^RuV$ 8V4Ynگ"b ]%2;`PDeVZSiJFKTEf䑘.2HqN;3'VGxR{@XrX0?NFJ@q7{߇/ \,f?qjlM Rfg{X%pDA %fqhSHEUܲѥ#2bc_$jKBz@] _Jqޮx*1&m:̷JaֿL-쬀*~XOYJ8C*$rm sr`V z/s/_S,)Cahp7ȦVdR2ͨxC|Y%T~'~D79vutT,`},~i~_gkJޜ_@J슊M (3F",z_ӂ# 헯 'F`|6;Lڻt*+̝:/c?QK5'iQg}mlMvֺk:7hPSJC]"xK;=e wDW_ &X s+-ϤD9t"I8Y t;*}ri`Cgˑ'U!ƻP; E4OnG\bK$>!sJO+OqsK/=9r=(,. Sѻj:3 യM rTlouIZ<>8 C^PYҎDOm(Rʰ=yZ\9,ntX>->b$AwךFYMJXgJ63Rcc_>phїN1ZiY%Wn)G ]Ͽsj7v8ivEUVħu()n,$M=IQ&zQ *9;=R2{X/iAvi(o&i^0"P9U^n *L27/gRMc8~~7C=He#cVkDykؐV.XYπoNu 2&ue|кJj.@z-_{#aӺ?xwB cPg?cAo4ь"p0*Q*RhaO&)u/lH?V,.Ɛ+ ܩJ,Zsj1ag5W:^[2an\b i>./+R%{V(3Sz]b@6!X|`cö.Px@0a;279i\n<_ d<ă2'jʂSrO kg7PV:vv U+?0LsMp1qUASq-QK防qܯC60,oG܃kƜ'E{Cov\X![aQ(F zTOC!ם-C PӁ8ȿpՍRho;4}''qnx= 2~:5]t_NV~#$6.赋mUJK f`5<팺ͻ kxdﴽʡCA=@]]{c%}Y@Vdqê P7-VGIZc9Ȍ{(h#rn*%*G>(iuՄ!zor3xXp[ʞ6u[t6x &ڊp Tq\*O9G08ȉ._\q|ȭe1f"Z$[OK+gï~q:.Ef%ý5)S&取i=%^OaͶ+|&bo`( r_|b05̭ KPܼ7(Z5#":zxM M'(mO_PhVBo}oJaf2-1,A 7_)p\7wk.O[ .M^ Ӑ .}%9vdQהs\9g:fy ?gux@e&#j̩!yS5IvFNx/+˲AB{14΍N9,NݖO@01'L(e8M@n\wU2վzLJ2@#F?7Oܙ CU?pm7uv"'P20?>N|eaFK\TCfDsi1L8+%|xzmh*h{zNKȇ:sB}c?jy=*&CӊΦFވU-d;P ={N-9ӆr]G))7DRcD{W:&y&e(vL+aҼC6\ 5tg{lբ2%h ?[m}W}I ,7ItB1Xs@p!e;WwZ_إEҔ#7Ssq.j^2Z!\zL~r:7b؏ћ`M%ZЍY`h}[޴.4al$V>L5-BclTHZ2dz}+g ?KTJnz$M|0ߎVDCYv;lirƒ%3}5HX&Ao3Qv34(c孤.j0Wwc7g3S25,Pr_h!Vش(-01P>)6 W'5։C[%b#Po=rjcJfV*^5(4%pa.A 9WiU#(u"B< PMv:jmfg"Lj@]8ȑb?uiK&@k_!Zg˷u~UpCcRz ]O0O9*'AN.:7b)ԨSK]ja@XFw@m隈ڳԟZ|%~V[G8⎒̳ƜЬ]ַɧ u#Gz_dLgU,,>&ePdg ,uanj_73aJ%# 7[T8ΤEc6a8kzk%h\!?(~䦰`^w"1k)W"^3Apug!b9BΒׁ=0RfDsyT<(@Í0Hz}/M@A/;LyTgĢGPĪ L̈́3q* 1I\3jEě7 01dE*>rJxz`&ǡt\#HЖ J8D:? FZ}N0mn QEM媇 !gK3ȱd-XY+ݓJfW(cYH^|?wxzBkV0KvorX>Oqu*B&tCz  gN\¿Em{T &]^BޅRvҹ| 1S r>x;>|PzZb}%6 VGu5i ʮ'h9T$&}HyR9j&L'@= B' (b !s}AʲlX T7A\GĚg&eyxU3q{EzOlm(xh8_o<$@7>X䮄0?j7J+Xm!4 i&>uDP syRGJOs kʍN(rA+]ȽJB쇻HK6 œSd"ͥ'=xB婚ɡTpfZT}&"ۛۻk _ڍ}A_p#q!hѸ?`BΤ@7A{|.}e(jꚻަVeq&HckVuaot `ea]EVΆKp;px337nBӂO4&CÂVVnHKuW< KtU%:0vE:JoD|\bAe!"*_ŀ1<6j;ĺ46aCpe0uƮK= Y!/NWSqt ,d+ .\W1ad<影"m^ovr^W3 \jͭLC1M 7G/V|`KxxQ+KNѝ1zyņp{:v:Gajx#H׸̄+ݔ. c27!ie YДBD(h j=-Ƣ'LV2-3yԥL[eJLwOgTJxR<2F 4c}\qيM1UlCy6FDv;TA2/`Z*ԓorN/fB>Q$v:nV1Т:ŐwtP~7/ ɽYC_}11hSALQ G#z3 E=XJK/ \u%Jǭ%9 Lc&#`-I-!dZwJOsQƛ[ H_"%Un7=^p~̈́Dw:<.Jo,a^}zz-L H.q]__'=3H@5Nد^]4.wd%1Ka}ƝvfR'j |QM-ײV9g5# w[t.5l.c'MDEyĨGU!thK׉ee ,4=j=\Tb3]!D61O7-:e N՜}D?]*ڛpHծ`jJ/D.V(',l3zVŹb:]Gd!y);f+0{/&0byo\bѬIYQ;C1 A:oy]`cT^z p\@'?x_<ʣr)>rR)af:X̷kK+GX> RD`kV9h+ q]|y`s2ƤŞGo8"k@%ھ#: a'}ӫp8VU>VҸ  5vׄv[y_fчtobMir]/4uM|BcG8=<*2 BrdݼdDU__~UF+~8`I΢bWmT.`m]O4ߵނW 'Tc/`i=l<, Etq(Y_$Te4ȫqw$3& -N.XFf^.;߫bN^X'z9Lٷ_N= r`S*UqDFju4iS>hEcs3=G|<U]uDQ叉Da[g}nɖ2T$<_r/·] X+}sOه̬# d0׍z,fARoSpM{ gӦ* ,DN-5IchuKHAȰ?/-"C7{SOx9gl3oq)g>b5`BʁAy!/WCGtg4Ku,mz pwu+Ia埽0b %rJz}E6!($^L]˿ow 5#aS{;ga+9֥톘G^A_M*[3fH44F?ZUp66#'028}ZBg-ƉU j% y|C (gߔ"q^t:wAwӚɷg{ɐo ) ]y )OٿEm$)-q` Y`r9 reM(c\•/~bnT+C]YB/c,0djJ<A+=853,fj:}/Z8HŴ ۏ6[Ē}ۯA1C h&1 fe**"찿5=S!>/vhathRBi ">^\g"\{B'B)6%l:wղ\i;|vGV~ u՗0UܿsEo d =0JAPURfckc.rUndA 4Pm&p.|4o4+zq 1JJ>^atN)D|3S;5ǧ:z}HrPlm2F}+K:67of\| q&7GmIt[C7H|ogy)܇s%orcFbZdYǠ2ۋo80֨k+N+Jt23lT^E҂nz&zfҚwCA vb/!PoεruƖ:,ѨN+Tvd[vUkb!6 8UΠj/AlRP'aIc. dmKZP`U>ME5A[R)<( ֙^ӏ)Ђ;#O@O@AΞԣܚ7bv [QR+\ :t_|xQIƱrYiZ!,1[8_ui9> Q$;bۿ,mS_ fh_j9C"`:'Fأմ8I~fb_őrdۡ7n1- Z>2%D(alm`W!WĆ)Fk%oz5bSI{g[>̘VHguU[7x@`lyLt4/;rK8PQ4Jy/kI| -$:d\vkQ ?{awȗ>PX}ɼ D2?iO@9Zpɖ{yxxy5՚V=gbf)o "Ż%#y\j 3ЏÛ7آ"lw)u_G@ l-Q~q{/k9'ޥ?_UD UV|X6_$'avN~X87IT3=P@"]#د.Sv8&_OP127aS5}Ucpo&@RQK^(m'Em-e>¢ F9ԪǡlprҼ=<4<9zQUOkyU4Mؤ >Wܓ,2*rq^''LO^R)K\o9Ԧ9HʍF4%ϟ|^t olw ?ebbL;N-w:R!fـhj;rB 5PՉ@nG/am8s(f?#HH 4drDU+Pd$ *M ,h1պzs{im6;$mRNFisϻq.Mm|0k\[v q^=Fǣ9h1f-)b#>h*lzfI4` sۍJ OXEc%f& '#syPOBJ,xt&? Q OC:IҎNsǪMdGJ[56tΕy̰oүK//vdVt=.'E%n:2rewD'9w;(z}Ea8)e.tjh{r!31GZoi@e * Ίx+# I89$BqpD2fg;뗢EqzSGlu)WU+qR-glV@kZBRɹ.!b]DbǗ+:$8엖#_sAwGit_vڎ8˵ΙU2`ISyj!,<f'i[{VRPz;Ј?\2\ϗ6L 9=f^1b̤lB!o, W[_mE` 0.oa!#g",MMlo[M~-4+nllyW֪ɁaѼc\ե(f^ys)f7VMvޞ1pNS12'P}v·%[2fMf{yz 0I,sOg0B-̯i^'!2Rk%ij N/WyWVxlF(f9$/{ٌ`G;qf@VojT cv($jZTWL?Kgx[3A9C3;_r7^k5P*sJ.m}sPW{&Kf7">h \xWަF\L>3ZG\X[ $0"+]ѶM1++E){Ѝȿo ٍm/x\@[6BzԲ줥_;4S-1ބ`ؗ=x`_' d{$H9pK2q!?_0[kf*je3N!2kcEdLhBg[›+&"@ykl` 藰{U^Yѐ?jôQA~`aML~va t[`84NB%`~fџ;?ʆ.k<9<-<:#[K]On' 2Y%?c&Il r[:] a i.:*s]6bE!]MJK_C]koaZO潋SU2A,v94;^)RZt~X4u>]xv|'ZMA#/Z86l,q/s!s-jhJg¸CZ7~` 4>~$;qRS5p)G'3L9sUB'\Śr6Ăx '_IIؔRlaSnFXWe?eI'tH_dJ>h`Оw8rfG϶*CY< W<'5!RvÁc1z oaR9WI3ܟEKD32v*h{ /wT FYZ) mm=A(Pc5߮HI^}Z@JBcd{vâ!vڡ &߻j@9m=WX:D_tjFA-ߧvr\$%,&eKvULaV.60ymw=j̅ P]e~p&ʠ>2*Yr~nf(ͧ)pvOfx}\ cd{J֔W\ -ރfPl`mGB̉α6džWRƣ'gA#A#0 oI^=18`EYuԠh4RC:r=z8ck3xrvwXPx#,u;Vm6-ZG_j[)$}ܤR7Jsd7PFFR{/6]i7s<䵮T">a ʼnܓ~=v03!mM\~79OTH<36/l1a$`j">1ϖ)7{ef8 uu$:"Fo7Ib:\z3h~vZ %;MUXގECJ;g3kb`V鍌7d=ϡ7XZ\O/0ewM:q8(Gv9|2C[UKrq7욹vov*Ce"C5I:@D;%&@ Kw(CW3A -*]癆BaW6it3W0E9Jp40h N@$$L3&eD=$VTEIf ztXöM~fՕ5yu.rjK(@(_n/Z\r$(^^-tHz= ;3_[_ T.Ҩq'm_tjEhFfǦFLM 2|7ֽs:'z%Xފ5)Q'D tǚ$gJD~i齜 y ;GǭVy |dl(VP:jDG6Ğ3 >;wQ>=+1%JB; ƈ.NRRsiOnsbF ^u)0*=h!f1vL_5 jR6sL7Prt"`+zr t̼?BFTzY;mcAeJӏy)0+"q/{skd}1bR۪*wMWlTtbg- U87PZ,ń[2u s4=f@)ޥ*X}ȑ^p4X_4Puf1 "{L@!mKAd`uW’MwPU%% \$ze( u(LA>:ؐ٨QNfLaBmAVڮ-mO-ͦKV"f ~\w(}ؖUT̃ 0<>ѫK<iH0luVP[#ZEq\87c]{$$15f}V:z6„2"qV-mY!UUPQ@,08X F,?`Z==u^Lb>^-6&M ő&b }J-og%.d.^vHVoR?Ma;yR Div3P oZouҪye;m>b2-'Gh^P |,Y F^OnW_C24]/ O0Y)jRN$va/KᚎԂ#ڄ{1o+$ ,8ӊmަF3"f}Ydxmꍰum)5*\U&άW>P9>[2M|v]8-a)Vbv qM#t+W}6JG3a<{ۆĴL.a'#-one[f/VXƆr!d33liWjI^}B Ru@UfH52,n{4 y9~nۤ6B r<$^̈́Ц-%$ZIPdO9;p#;D͛KWi^ב ?B76V8EX-CX߂b;ev-y2< _GӾH>08Y^Mt"1'//:@gn1T{$;VQ/2pD9 bLI7Em<ƛ]D6"nO>ԛHew"xB颶i")7;sU /ad.>ĈM'Ճ!ij@#PKXKW!-{5_"5oOzEy ~`, }*ZF}`Hq h p;Ӧߊ /jo{ oվex4Ek-~6!8.&kN[`r۞5!5eδUY2A0-Pn6M^@ku[9^K\c[Foq+ g(tۘh.w\<@aFY]+BlNUfuCϢzvFD$)Zʚ{_bE/,E+Ù{sQ+FmHsv45LԱ%7x("TLÎ٫ɤЭ} p^ίlc@7$P'u5H/n3kSo3@HAcu^Uh;wEdVbgTd9Me/:TRA!(k=/9]M8!AFoCus90J]䦱3h8BYXzF na]ʜkŏD;86+۴rg>;Qjq8^?`_֏}Q(pq;<ܫ8WaΠ+8:/gD{SuJ;FU7}|V2E_Q,L0&#60s+8_'G?+bW[ =J%"tJpƧVI*'~u#تP *Z܈˦'|5ʗgC3zxh9v:ؐŎŝ14$"MHý!@V (p̬<΅Եy9[D*~Pi9u+1%^>}:)O|\+4A[{ oRsޯs~?"qd>.}ܥȱWyudcRt^gsv<Ϣe*L="/uJ*&#<9ErtLmj! 6B(Gjeԯw(6yht_a XzaަG 9pϳ"[ĸBOQ0Uscvǿ+1t%Ɲ"ݍZ|لXQF'5 TinEva2^`B?lW]20gΪ5,AxH3fɭNTVuD>yEuNǝi)&6MJ8KDV;v6A FDDg;e~HUHqf~h[%ߩ'LP*K#eScD-Ң#qS? MhvG75%Y 9n90uQ,d3?4M"$|$YH歠c&" ]{{Im3K[# sDkXiBĬ"ha _`c/s4 kWewR*{ @8QCCE~iA,BH- !JliM,&PjKhx_TATさ_E,a&}4x8@j19:L)nr4 <2ɷJF)*bX[ *WljNafӄ;^j6&N<`0`ZVKBtrϊ c hb+2IH;HYEVdi #'_`WSFdDTf{ u3ʹt䢮Yu[0\v|%aWV ڗ%1cw0J>ಢ֟8'rNÀ~Zɞص&%p^ßoNwf}%\i ܏0=rZLLiZH)8s[5-}<2xxn {DL2Re^FA3m7Gd1#=L6o喆pW/%b)GTQVcGyofjcEHLVPn3s S2qQs1K.9 2ao~ߜRFYur9A 2 =DcPO_%[_>C*XQze0uKq~zLEP]D6f-@izCcK]٣~ (8F"[q3&C^,s4HjE;Ν"? R\ w9wzmgrjam!D eG0/\o,..mQMdfsU-Ku{eJL 2#*ez\f{vk>S s#3-ӥ>,"{L$du!-3OArxaoi5eiR=b/$bu˧:: Q~*H.`CwfCzsçTX,벎▾ӾUJ6#OW 9]?.|zT^ʧۄ)fR# %k3B˜"}:sjuyM]8o΂|YQaQϪ dbXZ}bs"M0t4:j$#@w>0 YZgraph/data/graphExamples.rda0000644000175000017500000001564514136046755015734 0ustar nileshnilesh=ksƑX(]r|u[.Wʹ$}rwdʎbYQ$K%IKrIėK'O_.=X{zm4zzzzV-Ze[θ8cW cx}sߺ{+~1/Vt 7&'.V֬c6f [x5/7{ǜ{9ܰ4Zޟ{KmO<dN/g&|^? , =C\q%eyI3S oӄ)pvaf'i߭6v`|ѾQw8?,|~wUw4mt]3~m9 YxAow7`K sRXw]F%AS/z8sY<]zk޺!=wO>*<{_ǰP'78o)3kjAbq Sl93=}}5 .K*7@S yWXv}, Xb oplc u@z;9s?+[;qXݒlH.l{&"ZyLϹ1,cInP.-V>"|"|>O!&#B~xqNCo2za?Q| o*C}#?/t(WK's/ȕٮ|<.I)3s^Js3Wi&Y[;?7 _SŬݹCWt9NK_YhQ/ y/cُK#~&egr)qM_w\}yMCd)?츳WʿAwrKݯ߫HH,bdL~bgvقB 'u;5ƼeV# [cYGtKR^ˋ?m1 K )q*Fb$GLLrE3!NRfիpW^={xvZweQ̍x9{nH=TM$GSyDwF%|LᶢN$\敋j9LM>Do)n<b+F8r-s9*]{W#U vӊ:y#ErC\^||r0픟t?~Ծyƻ'=Pf>Ϗpډฟ:!O#;<S/,?0-DٸUvUMrw~IeSuU/[:p/ݦSrWάU)t :N)}LbY2s5,bbELL'q\(!ID6QԖ)\$U]Kz>%lJn)P?&[!_Ϝ{e)/ҏ;?q2-~-Yۛﵴ9=$ %~i 慇Yx9S)Cl΃NVX`砗H7_Pyy?Vb{`ٜƊO:)]l5l{io`{Ml>6~m_amlͶw6ǖۯn`!>o1To`etU!gMYrpzBΆ)Dl Y8}! 祐Jpv@]!gO2q^ 8!@ 8B0!H9qNpSyH~ / jNAq@@"I/~ +.36w׀ ]@7 ?~?!އ?! q<A#\ uԓ2@E`;~g `\P +<e3\ G\'ϧVJod"~g$aODR/!SAJ?b\7Yf^PgCq _vG_z@. >`~vyM.D6rpT~5N}(?׏'y^)3*# PHȃ>e~\(ғF\?5(Q(1/.@y0/p?7^4Q~?t+t޻PW6'ţ?+AM[q׼Y7G ]y0 ׹.@L[8^b'W'j\G2T5eeߙ$%#2^i}IGS6\;P5^%/Y2uyq*/MHZonHƥٞ$qpSq1>y/x3wk'I<ȃB?+|{^T_ިCA?дjq: =oUy ,@4Mqm3*{RߌL:/N璙P?BoF3qtޜlGD=IB7NקGGϗeRV-e==I%MsכFo:q'TqTSTOg]Λ91GȴױCSRĎym]ir.ێL&&͓Q͗ iƝyEMBn^:#37:s`Z?E7H>m7D|AүO}WI<<xbqH>秵'Y{G})pxGk/Te>y0gwq&`/yYK66`RDWTqY| @Yobk<#p=qsOp]gԎ|I>WtRJoҮc/žnQiG>w(:23ˡ>shGTz8 io#y0_,OA}^b~hKIvVjzxl |c%tW^W3GLp+0F|t*톋گq(%K7\N?lE0_!T~![|w `Sq. NMsTP[yP;m25O2?ǓYP?s늫Oyg6!>`7u-~@Xg;it'iXG{\D7">g 5QMNh컸~f%:ry~nN~O] sźV)x@7 j;pִS%];_:ǕW~~ǝߌ|O2. =W>_Pu^v-Ⱥ&R R3OO5 =Bs/t UvSn(<:yPxR}Q1~.>EIz.S{5e}';N{(tI{Sו7꭬ >=OK{nq ? {# o^ƗlyYkow*yyxP&u2સPsB y\sŽ?Cgxq %RqV&w>w$˹f#qfƗr(7l%֣'XXְf =5XK}yWXv}, Xb oplc pŦګXZZ[[Xcf6V;l{ma}ln6bCloaK''X:E8]!gUHYbpօ!$l Q8[BN_y)p<!gWH"qLB(@H9bqB.ΡFH9ql!\:~̾Jίɻ2I'R Tm;Vîw}5>9oy.fIu _R18v7bt- r%Y<]zk޺d&ngoSJc),ɍ7sTٓ#Y;kBg'(*jw6AIsT:톯u7CN«vo} ݰ,S)\j:/,[ V&B!Ϲ^W0R+WrʙegA@H,_Q9⋗q\$a?4䍎|Skf|ϴgCwbei=Dn.t߮%K2u22|3L*w*{ݽƼByvS;jP~MVv-nN:oP'o*}=nj8 ~u~L)}Q o&~OJk*WsJGWeTxZ ~y35_6*MU$1Y2&{&L Cqߏ%)75NKxf3>R̒]ݼ:+Lw|K:o {do%lvN ;Z~7 (}nh'W^]~y0rX~Y?P۟梓n ?0{bٍ+诼n9Ħor>yO|Wȷ}wS-I>TBs=uzf݉ŰwJUGwel:~% SOjkrC)LnY͜?#(Cqk0&7~*cle7e^ns.+uZŸejww{C22EnZFؙM\rkjoFۯoUr jgfM٬7+*B224[T;qa%0fElu^H巭]k~)V`]_*~9XKlvcX@g٬|5kZhVlY[nV஀6T%KoOVMW 'n|&C>FR*P}SobYnL\HߚMVE3NWFzPNͯoWԳ^j$KR K˾w7z뎸Ҩ5[wԸ[~}WJױf5V7UOhOx)ۭl˾uhv1~SCӮ7-zywRǷ!cR[5N|elN=lox3fMȸ\F7u_2er3ܸGlr@gZ!;U_,JҮ5}6E PHN gw51u©<c{O9+8|,p9ܧ.'_%E-'gxSܿ>'ot󿗹}3s'xqEǷkrә ȃs9:#!/% 9g<~s}GylOŤOb􌓞?k.gF*7.:P/8J~*Σxgtq^U|].ݧ%3b8-iR£/r?|/Eog+6w*+=G|,E|GWq}ZÛ7:O=9,aMn?(L9^{ݮIeWfmu-/|/ys>[N>}k_'ot~=gk\Գ#q;9w}7=K׋?boh=}*aPrz'/'bI|'8p;h sbBνւ{C't /,mai%@T<graph/data/defunctGraph.rda0000644000175000017500000000137414136046755015540 0ustar nileshnileshXKo@6HHP*HR!L"eVG$5~R"of<0R$II)%)b#!I;qC:"n1;ƇċL_0Uav"GG|R_-D) ^ Ͽhj;Qߗs1ws=A{T7Lb2ʠ"0(P& 2耓0*Ԥ ʀq@f!3 uX.$f.$U1^@hY!aApj͐Pfx_sMa-Y 8z8 UaiqhHu4і3m:gMysX13<2ʫvs~ ̩N6;O-4v':dE :uW\G|X (H5iSKx{lpIgraph/NAMESPACE0000644000175000017500000000561314136046755012744 0ustar nileshnileshuseDynLib(BioC_graph, graph_attrData_lookup, graph_bitarray_Intersect_Attrs, graph_bitarray_Union_Attrs, graph_bitarray_edgeSetToMatrix, graph_bitarray_getBitCell, graph_bitarray_getEdgeAttrOrder, graph_bitarray_removeEdges, graph_bitarray_rowColPos, graph_bitarray_set, graph_bitarray_subGraph, graph_bitarray_sum, graph_bitarray_transpose, graph_bitarray_undirect, graph_intersection, graph_is_adjacent, graph_listLen, graph_sublist_assign) importClassesFrom(methods, ANY, character, list, logical, matrix, missing, "NULL", numeric, oldClass, vector) importMethodsFrom(methods, coerce, initialize, show) importClassesFrom(BiocGenerics, connection, dist) importFrom(BiocGenerics, union) importFrom(methods, as, callGeneric, is, isVirtualClass, new, slot, "slot<-", slotNames, validObject, getMethod) importFrom(stats, as.dist, dhyper, phyper, runif) importFrom(stats4, plot) importFrom(utils, modifyList, head) exportClasses(distGraph, clusterGraph, graph, graphNEL, graphAM, attrData, simpleEdge, edgeSet, edgeSetNEL, edgeSetAM, multiGraph, renderInfo, MultiGraph, graphBAM, graphBase) exportMethods(DFS, Dist, acc, addEdge, addNode, adj, adjacencyMatrix, clearNode, clusteringCoefficient, combineNodes, complement, connComp, degree, dumpGXL, edgeL, edgeMatrix, edgeNames, edgeWeights, edgemode, "edgemode<-", edges, "nodes<-", fromGXL, inEdges, initialize, intersection, intersection2, isAdjacent, isConnected, isDirected, join, nodes, numNodes, numEdges, plot, removeEdge, removeNode, show, subGraph, threshold, toGXL, union, validateGXL, coerce, toDotR, attrDefaults, "attrDefaults<-", edgeDataDefaults, "edgeDataDefaults<-", mgEdgeDataDefaults, "mgEdgeDataDefaults<-", nodeDataDefaults, "nodeDataDefaults<-", edgeData, "edgeData<-", nodeData, "nodeData<-", attrDataItem, "attrDataItem<-", "removeAttrDataItem<-", ugraph, leaves, updateGraph, extractFromTo, graphIntersect, graphUnion, removeEdgesByWeight, edgeSets) export(graphNEL, graphAM, boundary, buildRepDepGraph, calcProb, calcSumProb, duplicatedEdges, graph2SparseM, listEdges, randomEGraph, randomGraph, randomNodeGraph, validGraph, eWV, pathWeights, .dropEdges, aveNumEdges, sparseM2Graph, gxlTreeNEL, ftM2adjM, ftM2graphNEL, .ftM2other, int2ftM, ftM2int, aM2bpG, mostEdges, numNoEdges, reverseEdgeDirections, ugraphOld) export(graph.par, graph.par.get, graphRenderInfo, nodeRenderInfo, edgeRenderInfo, parRenderInfo, "nodeRenderInfo<-", "edgeRenderInfo<-", "parRenderInfo<-", "graphRenderInfo<-", toDotWithRI) export(graphBAM) export(MultiGraph, eweights, edgeSetIntersect0, edgeSetUnion0, extractFromTo, subsetEdgeSets, extractGraphAM, extractGraphBAM, mgEdgeData, "mgEdgeData<-") S3method(write,tlp) graph/TODO0000644000175000017500000000023614136046755012211 0ustar nileshnileshsf 24.01.2006: Need to improve toGXL so that attributes are properly written out. wh 28.01.2005: can we have a "==" function for graphs (e.g. graphNEL)?