graph/DESCRIPTION0000644000175200017520000000465714516033236014422 0ustar00biocbuildbiocbuildPackage: graph Title: graph: A package to handle graph data structures Version: 1.80.0 Authors@R: c( person("R", "Gentleman", role = "aut"), person("Elizabeth", "Whalen", role="aut"), person("W", "Huber", role="aut"), person("S", "Falcon", role="aut"), person("Halimat C.", "Atanda", role = "ctb", comment = "Converted 'MultiGraphClass' and 'GraphClass' vignettes from Sweave to RMarkdown / HTML." ), person("Paul", "Villafuerte", role = "ctb", comment = "Converted vignettes from Sweave to RMarkdown / HTML." ), person("Aliyu Atiku", "Mustapha", role = "ctb", comment = "Converted 'Graph' vignette from Sweave to RMarkdown / HTML." ), person("Bioconductor Package Maintainer", role = "cre", email = "maintainer@bioconductor.org" )) Description: A package that implements some simple graph handling capabilities. 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, BiocStyle, knitr 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: 2023-10-24 21:26:54 UTC; biocbuild biocViews: GraphAndNetwork RoxygenNote: 7.2.3 VignetteBuilder: knitr git_url: https://git.bioconductor.org/packages/graph git_branch: RELEASE_3_18 git_last_commit: d6b871a git_last_commit_date: 2023-10-24 Date/Publication: 2023-10-24 NeedsCompilation: yes Author: R Gentleman [aut], Elizabeth Whalen [aut], W Huber [aut], S Falcon [aut], Halimat C. Atanda [ctb] (Converted 'MultiGraphClass' and 'GraphClass' vignettes from Sweave to RMarkdown / HTML.), Paul Villafuerte [ctb] (Converted vignettes from Sweave to RMarkdown / HTML.), Aliyu Atiku Mustapha [ctb] (Converted 'Graph' vignette from Sweave to RMarkdown / HTML.), Bioconductor Package Maintainer [cre] Maintainer: Bioconductor Package Maintainer graph/NAMESPACE0000644000175200017520000000561314516003535014123 0ustar00biocbuildbiocbuilduseDynLib(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/R/0000755000175200017520000000000014516003535013100 5ustar00biocbuildbiocbuildgraph/R/AllClasses.R0000644000175200017520000000720014516003535015250 0ustar00biocbuildbiocbuild## 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/AllGenerics.R0000644000175200017520000001757214516003535015427 0ustar00biocbuildbiocbuild## 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/GXLformals.R0000644000175200017520000001100714516003535015240 0ustar00biocbuildbiocbuild# # 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/MultiGraph.R0000644000175200017520000016737114516003535015316 0ustar00biocbuildbiocbuildMultiGraph <- 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/NELhandler.R0000644000175200017520000001017514516003535015203 0ustar00biocbuildbiocbuildNELhandler <- 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/R/TODOT.R0000644000175200017520000000753714516003535014130 0ustar00biocbuildbiocbuild #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/attrData.R0000644000175200017520000001110714516003535014767 0ustar00biocbuildbiocbuildsetMethod("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/bitarray.R0000644000175200017520000000561114516003535015043 0ustar00biocbuildbiocbuild .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/buildDepGraph.R0000644000175200017520000000025714516003535015741 0ustar00biocbuildbiocbuildpkgInstOrder <- function() { .Defunct("getInstallOrder", package="pkgDepTools") } buildRepDepGraph <- function() { .Defunct("makeDepGraph", package="pkgDepTools") } graph/R/clustergraph.R0000644000175200017520000002436314516003535015736 0ustar00biocbuildbiocbuild##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/edgefunctions.R0000644000175200017520000001207014516003535016060 0ustar00biocbuildbiocbuild################################################################ # 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/graph-constructors.R0000644000175200017520000000102314516003535017066 0ustar00biocbuildbiocbuild# 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/graphNEL.R0000644000175200017520000005130414516003535014666 0ustar00biocbuildbiocbuildvalidGraph<-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/graphfunctions.R0000644000175200017520000002166114516003535016263 0ustar00biocbuildbiocbuild################################################################ # 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.R0000644000175200017520000002353114516003535015144 0ustar00biocbuildbiocbuildgraphNELhandler <- 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/mat2graph.R0000644000175200017520000001022314516003535015106 0ustar00biocbuildbiocbuildaM2bpG<-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/methods-graph.R0000644000175200017520000011111714516003535015767 0ustar00biocbuildbiocbuild## 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)) { nself <- sapply(Nodes, function(n) sum(n == nl[[n]])) return(deg + nself) } 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/methods-graphAM.R0000644000175200017520000002753114516003535016213 0ustar00biocbuildbiocbuild## 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-graphBAM.R0000644000175200017520000017143614516003535016321 0ustar00biocbuildbiocbuild## 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.R0000644000175200017520000000752314516003535017007 0ustar00biocbuildbiocbuild##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/nodes-methods.R0000644000175200017520000000607514516003535016004 0ustar00biocbuildbiocbuild### 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/random.R0000644000175200017520000000636414516003535014514 0ustar00biocbuildbiocbuild##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/reverseEdgeDirections.R0000644000175200017520000000047214516003535017512 0ustar00biocbuildbiocbuildreverseEdgeDirections <- 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/settings.R0000644000175200017520000001542714516003535015074 0ustar00biocbuildbiocbuild## 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/standardLabeling.R0000644000175200017520000000133514516003535016463 0ustar00biocbuildbiocbuildint2ftM <- 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/toDotWithRI.R0000644000175200017520000001245414516003535015411 0ustar00biocbuildbiocbuild.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/write.tlp.R0000644000175200017520000000160614516003535015156 0ustar00biocbuildbiocbuild## 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.R0000644000175200017520000000121614516003535014060 0ustar00biocbuildbiocbuild## 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/TODO0000644000175200017520000000023614516003535013370 0ustar00biocbuildbiocbuildsf 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)? graph/build/0000755000175200017520000000000014516033236013777 5ustar00biocbuildbiocbuildgraph/build/vignette.rds0000644000175200017520000000060014516033236016332 0ustar00biocbuildbiocbuild‹}R]OĀ0-ū@Yü€Ą“1±æ€’€01Dc|šµl„«ni»ßüß&bWZč ńamļ¹·÷ܝÓ÷€(ģ€ TĒpؖ®śśź‹Azjæšs“Ī $ÄųµĢ :\Ō…¤'Sż“؅Ä\'¼G<`؁‰”œ.k‰w=Śäŗ œbA 3Ų¾v?Y@Ä2x˜źA°0e7īŗ4£BźČTÜ>V(+X eŽ”ī ×(żDۚĆxpUqøėö¼üĄ©Ž°×޹, |©œÜ „•“HˆŒ|µtī”\ĘKqä”5¶ķ“AĻH+yŌ§)wŌĄŪs1&ŽŅ±h/—­ģ“+’oŚbץÄüeľ½„9eqÖą×Üp£Ą*±¹kĄhF ū2ā7*÷Aų2™cgÆäÆ1Ėģ{<Ā_›Š«øMŌćÕflÉ.æÕ²Żnü‰ŅĘ>oö$CW\ŻWŃī”Ņgraph/data/0000755000175200017520000000000014516003535013610 5ustar00biocbuildbiocbuildgraph/data/MAPKsig.rda0000644000175200017520000000136514516003535015540 0ustar00biocbuildbiocbuild‹ķXKoŚ@6Æ`H‚HP*õĄ‘ŠHSŖŠĮ!‰L"­”«……€e›V•öG÷$ŻŻńś]»j/Éöś›łffč˜Ź·ķņmY„¬É=G†ł,¹e”Z"Ļāgi¢X ]Čä^†L…ÕZCTÉuā€ye*Ż8ć½ÉµŅ™žń·©4ŗ”¹­(MÆ./†ēœ&)_:īx* ł˜$o<8åćĮÕWÅēś’ĢKH7“šŅu^ŽšÖĘ0LdY ÕXvėµcØ6g?ģµußj˜ča­¹ųaS]Ł‹7Aēć¦<–>6 s½\Ģ[ }åZš3“\6¬łbĮ…GšŽFd·j°šģIŒB…®FO€OÆīņ˜`óś±×Żå›žĢn‚E°ˆ“i°˜† 5FŸOS‹œ˜·į"wKL²¹>³YcŁŪ?ó„™Ä—.gūīŁ7ezčö6OĄõ¼ÜÅX,Ģó±ßó6˜ļł{<<ćvFžĪeŸļŠy}ģsŃM0‹nņdŻĻóü>'›oōƒŁĪ-Ɵń.¾äÜ%ŗČ“¢Ū:¼žFńŚnĆķ]čę%_œ¦nĄ8MBĮęõ1Ü|Cxų$YmC«]øžĄÅ\ōą‚—»īł~w.xō¼‘ūų"F“«hž dŗ˜/iN¢“VśĆģ’ұFīGū+Ült•ßlÉ攬<†VĢÆw'>Q%>U%>S#źĪóŒę¼Võ¼«Jl« §ĆBŽccW͐ɉĪ>6¾RMéP•ųBØąé‘š'e¢įø¬ŖGl”É÷lff0TW¶²²»Ā‚1ŽcT–‘yÖib(×4ąB»·…°Ż¢M*ą°LĒĮP³˜TänZ±kC͇APŅ”PO†čC­ēOŗĄwR|ĀčŻĢ’ėū~[ į3˜”kbnŗAISaIŽÜX¢ąM"a=³1”æŗ”ĘĖ!“_ŽČ"Õ ļ”·QX7æ~?«¤Ž~/;Žęaē ‚^p)Lq!xåCīgÕCs‰ā±”ŒE!‹>ō„²W+œs3œĘQDałÅš*=a¼\lźdōöäŽj_¾²Ŗūfœ%graph/data/biocRepos.rda0000644000175200017520000000354514516003535016234 0ustar00biocbuildbiocbuild‹ķ\ėoŪ6÷3¶•Äqģ¤]€}†}ڇaė]lU^ ²Śiź [æ*ķŃƐd·)ü!Z’¤żķōą‘GŹčõŠšw¼ćŻńx”Å287ŒÉŲ<|± ‡Ö¹}:>{ŁgB1¦N§¶#Ļbė«·,ژxdd;£4 Ļó##‚Ų4ĻNN#ކ1]ö0UŅe¢ńgˈ 0‘XšqÅõ­€Œń@Ów'L§ē!=•£ żłįŃ8bF$„€VĶV¤fƒ]ų<Ų=;ć³ƒŪŚŲw¦ē‡aņ,”f²d åyƼ‰Œsœo“7qd<Ćłƒ˜[md˜Ń ķ±s¹3š“éNYZ› Ģõ‹ńōéccö`ųē0Iœ/‘y‘RĄ¢fœ3{f80$Y¦‰ćGZ9'Na'›)õ©į’čĀ·˜Wć‰ī6LgrŁ• ņęÜćėŽķ2 įı=fHÕsx”—m˜ h®qILkD¼§$łā.S‘Éhźq‡“§±?ŅžĮūnb+‡ōõ½ČĒcg# $c3Ī©Ų/bߦ;ffæ„„‹©kxżžĄ˜LloĢŌ_‘ąńOĄÓ‰į²ķÆr|Ŗ%ń1ɘl‡Ž¶æV_§›X…ž\¤H<(Ž«•^)-Ri[NŅ-I~½”żčMśA®p†Ė*œ 1!¾—“•õÖRūpSĮ[ ”õć%Ķ“¢I#ōmæ¦ķ7“]Į›OPW@ŃmԘ… H²š“ĒØ¢ße3n-iƲžmŃh’v·å*`ź÷KšéÖµgŃ`@.?¤ķ£b&Wu*¦]gķ³bŠjL]&Ø,EŽZ ¢?”3žXlĘ:sį)m’\)ø=Ė`Łē—Pę#XXxŻ”†żLŪ_>WŸ?½@Yß]’ó+śžø~śŽuÖīÓž>ķ/kžꬔ<’¢{ķõr¢Y.ŗnu¹BJźæf¦ėGÅßZ€W°čT“ä“[PĶ-cĮ .ļ!ö3h°§U82 £žgėØ÷iæOūƒ’o°*:u½čŃ_Ļ}‹‘£r½œčÖsßVĄ°ģ¤Ø‹ņ2ŖˆmׇÅßZ Å\£_RōÓkŚ¾ĖŚ—”žR§-åĆĆśŁ%āA€?¤ŅJs÷/'aĆb o-P†Ē㻟žpžß|× Ō[ļ’zėy©Žz«·Ž„ń­7Ō&V“šIŃ:HöJžź®–픓8Nåź ÆÅņÅ0[Ś×Ä_D„uYI*I%©$•¤’T’JRI*I%©$•¤’T’JRI*I%©$•¤’T’JRI*ÉRžV}JGtł­ś\¼No#æYļŅAóÜ {—SęāęVvŪ>_tĶŽxų¶}rš„{hŅŻ{›ŅE4JåÖo &HfJLQ×2p”#=a€ x³°;ŪCņi›ęłūČg Ą-Ģ1Ā`=ķĢÅ«ćVFäi3šĮ”¶Š`ž_ō8/‡„ą¬0”ĖyD”ĖĒJ±ļ!Žt„ŽA,Œ,č€rIÕ£sß{Œ–Ėé6caåk<1Gh‡¦!ōD:V2"NĢ9¬b5ķ ؊”“Ąž„,Ē{ęÄm:CTÜadѦ ސČė@Ęi«‘!<ր‚­Ń1GPŽ6±¬9ĘpdĪ'TqŅVBĀŠŽfB@š-é L­ŃGwąØō0YŹ?Ē*!āpˆV%”EŚŠLŅR ¶¦Ķ)(eč8¹^FY;ŁĢXyšI‘$:˜…̹éyÜĘĪ"6¶e į[äčö0O4g³pĄŗ#UŌõģ"×(§»–ŃP,©ØieD“Ń€ĄĄ2t‡Ģt9dFŽKˆƒĀūGŌ,gŃxĪŌå ŲŌćā“ĆY‹ĮNh:ö“ʬ<£ĮR¦.J:$YÜ&]›’K$ā “Q„ąo ‚^m¢GįĢY…rYn&$“æÖ ji;” Y‘ƒpYddÄå:¼ė£5ÓØÄJOcDQ"ÅÄĮ‰a^cµ‹ Ń÷‹LNž)„ˆ:[IĢėqsRæłįćö“rp܏ ċŸ½‘ĻMØHSrU€ģ]Ȅy1kÉFśG°-\ɞ„8TÆ,­sÓ²ŸJV>80Ž=„+Ļ;ää°C Kļ’4_‚Ū7Dgraph/data/defunctGraph.rda0000644000175200017520000000137414516003535016717 0ustar00biocbuildbiocbuild‹ķXKoŚ@6ÆšH‚HP*õĄ‘ŠHRŖŠĮ!‰L"­”«……€e›V•öG÷$ŻŻŁ5~«öR"æ™of<»čŪ0Rī…»‚$II)™%Ÿ)b¦“ä#!I„<¹gæČC՞R"õ:ąŹĢ:²‰Q"× ÓźH¾åöŽšFmŽĪÄÓHī_)Ā—•G×W—½ A“ÕÆM×É=a’¼²»§Āī^S¹źČŠh©+ß?Š‚¤õ†zź)ßŗüa_vfŠS;nX§Ūoō]}{ßC‹?Õģ„iZȶ«š¹0ś[ī(ÕĘ?…żPÆZčq”»ųaM›;Ówžąćš2?UMk1›NźUcīzjc4›Uķ„õbžĮ#Ż@}²Ze<»§T¤ÓhKš×®š{ŽĮÕÓŻÕóe¦ą“'ė!Ū„N Kśy"m'Ń~ć-æ ±ŗ=‘¶J·0  »zūŖµxU“ü^ܾb=Ž€’‚Ų>‹;į÷q‰ĶųC:"×ń¶·n1Ę;ĒʇøÄ‹Lü_¾€0żUaóv"G‚äG|žR”_Ń-āD‘Ö) ^ īśĻæÖīś½hjÜ;QߗsĒÜ1wĢs=ÓA’{ ūT7±Låbč‰2Ź "0°«¦(P&Ŗ ƒž2耓0č*Ō¤ āŹ€˜ĀĀq@f!3ķ ­u‹ÉX.$fØ.$¢U1—^@hYņŠ!aA…pŅj͐ÖŽPfx_čsMa-Ž•Y 8 ×ą‚z8 ĪŌUaiq” Æü­hHÜu4і3ĒžÓm¶:·gšMÓyĆsšćXģŒų1ĀŌĘšŁ3†„™÷<Ü2ż•ĀŽČŅöŹ«vsēüóś~ ”ĆēŗņĢ©¬N6‰;§O-4vžĀš¼'Ŗ§—:dE—ż :ōuW°Š\GÖĶ|²X (Hų”é5¢œiS³ÄŠKx{ŁlŠpżÅIõĘgraph/data/esetsFemale.rda0000644000175200017520000016310414516003535016542 0ustar00biocbuildbiocbuildż7zXZi"Ž6!ĻXĢē=ę])TW"änRʟćXa“ĘqÅjnēj-&źa{ŌśŽG²%D·iæā]“’_mź6¬N½xZ• † Ďūę×ĘŖ ¹ų°,ł›Ø„[¬ÜĢYó^驟 °kM tUÅo©f5GŃ-ę> „VŹų¼k¼¾”'O¢.ęÄI:“‚™4|ó­ģó€ ŅEØx „įw™8ž"śĻę[§m”Ēģ_—YWƒ³m[³Æ]ńųūźŸżjhjĆ< Šl5x݃ÖJMrL»s÷—Pčūś¤Ŗ|“u bšö I'µÓėłŗ„čm_ZYXĒēyÉ:©])䶅־LdÅóŒHʾäČwŃ>ū£złŖ¼ī¬=£Z ›ŹōIŠjØX›µX-{‹É£ķĻEŗ1[SN :€j²QĘ(£µ_vŻ,—kéłöäbū²evmāįŁ(’Ͱ!Xó{#~9p;Ģ{-+(-‚U°š3瘮=,b0©K}: ±ÖKö¦¢ĘžĀĒŽźvŪŖ|xż{ŠfńŒeŹī¢’Ņ-®āęšé»?ž€ø»mĝSS 監>æL–‹óŃ=ę”_«ŸŚ K¬‰Ek°ŹŁą:§ĶPq?ū&ߊ¹ мŪcŁ’Įł’R–D»UėĆĘ;Œµxh;¬«“dœVā8–¶†0ĢŌÄ ž°„©ū|Ä÷\Žé©¬Õ*ģÖÖŠÜ|Šj·f²ŻTkĀõŻLœĪ3lŖzö»ÓP½Ptˆ›ēŪ·žįбS*^ŌVßń/Ąt¶¦«(F €¼IĪ›±“_-āµC'Ų\’ڰįŒ>‹ Ū£sŹŹ5;”“ņJ°aD]£¤Æ 5›h¼sÅõČ„Ņ&‹Pfq˜€īɾšH²¢:mŽÄ)^Š+ßpBw“÷)„<6ēšžä|aåĖōLr÷ĻNŁįųB’µėP,ˆ”@9f¬U™ąÖ!M\ŠL’Mų5›®vBAł.n×[Š#)¢q,Dōóøw__s\’Ž"÷§fĢoū1ßz½‡a…—=逾qÖM©Ż²2riöƒ‰¼²sļh³ŃŚr½ÉqeAÆ3 aĢVŖ›4ddY!żźQÓ¬ m2™Ī,Ķm¶HNTötfk-ū¢„ėÕ`Łr×9öļjnˆIŪ4¼7„#…čÆrN°£ē²]\=F GP’žČmæ×xˆy¢©š ąMtč®b_ekõ,S¹j5šI¼ļ3b®9.ķ Če:‡ŹžŌKf5瑼ƒŁÕ÷šMŅÖAÄö¢ū›äo© JāY‘ė«cø‘ł;„BIFx”将zÆjXäĢFFų{ĘÖvéūĒŃĶߑ8m¹3ĢqcZ_.éŲØŠ\L^0ßĢ[ąłr»šÓ åĒJWķŅé¼£ŗ›īį£ńioVlū7D=OBy“#¬BŪµYŹö—“Ø+Ē;Zj&\Źų9opöZ ģZTuE£)Ų¾L3“%מ’»ĆD©¬gc+ŠJĮH,ńnĘ-|yW¶¤£Ņ˜É£‰Żń÷Ɯ”į ”ĶsŚ7wč?uH¬¢KmĖŪT¢ņ½ĒĖh8ø1nīÕ#'„¢9Ąwž‘‡ŁR6"IŪ†ŪŽˆį~nAf”¬y…\/Ķég©ÅOć aÅiińĪķ'Ö Į•øp]ÜģKłØ=Ü£ųÆ`zč…׹‘&æŻĪ¤'^mā“”•A„ø!ģ#»Źļ±!bń3#ÄĆżć–³ēé-Ö/> ké ×¼S\Ģ>äĒ÷ΚÆ&ōŚ(ŲÅ@MMķv³éM–Ī+ÓÕ҉f F¼:¹(аl܈sÕåŖ%Xϐ]ōĀw‚ŹÖ_DøU¶×é^²ÓlĢ|źUÕ)jӄ•Å1¶¼Z„АX“#ų +*Ńō\»ASBųāDł‡ā[uw¼l‘U…*Ū‘ŽB•~}`£S޲˜¤rß/ńĖ*ō»Ķf)Ŗ¬Įu \7ÜjóMZÓōŅo£'øHc|ŗ’$•qņ#2ƒi'g‹wĮza×ņ”5ühw…AT"ī wøŒ?õ[¼(Ų ®m†ČÆ`^ éņõ › ĪĄn OÄĘ“†Ū¼5CKXć\„K&hS:’F’_NŖe\¶ōwjēe¤l’u˜KEš\øńSõ\”øž–=†Z hB٬ā9œžĒ£÷Ą8“&„Ł:²;ŚĻo}¢ä“‰pėĮa6»ŌG|‹:É@€ ¹&MU J§(¢2Ń\+–Ŗņj"ė®_ķ  5vŗ‚d9:Ó·ÜļR„Ó§Ųž?i¹¦žŖ žśõš‹Lc‘ ##wņ½grĪš‘¹NOHXbżƓŠ&”ūGīš’Ź[S{kī»Iՙ†K·Ü]•q\ف–ŪĒuŽÄpą23”4p«/ʈŗż9łģe³7’U\{äņ¬ĖœsBĻŖ[VG<“ū”Q²³ĪŹW‡Ć’ågŹė{Č6—*›ŹŗIYó"źģ’ķ7InŪ6›œ&§£N9*Ė©€6­’cÆ­ŻDMįRĘȹśåƒ’~³°-(Œ¬óäH„²ęa¢”„œž’ČåE,ZƂÄ°ż¬+«†ć„ĄŅ]2¬ÉėÓ!vŒ˜pßB ‘)ā® ½^5ȼƒ?2É8Rb „ų^(5N·­³ņw³“D³¶œ{œ Į~ź„÷Žméšūwfc¬Ā_§ĀÓĻš-ż?`4¼ ?©6½„szŅäö@­^Gt 4D¢ó : )“ŃŠI Čóģ ‘Ä#)øhŗņuslĖį@Uš‰ż—½{ź‹¢>czqHØĘ†¹ŹævŪē>ŖIą.t“3 Ōד57t&מy»¢µŚĀ>趏–pA¢ŽŽbLˆĪž¢AēßrE;į¢Ņ£ĆßĘņ«TaĖõ»żÄoš?ąŒ5éö©3œe5ŪŅ ‚4 všEG:g«Ų9Mc{DF($žōqdQPø#Š }Gįńß>ˆד{– ]ƒ!­č¤5¤L—g¹mßõ6lfA ҽ :ĄŌ•ilDĢźÜø(*’ŹĢ€ī!Å|;ąÅĻü{AfĘłå$ųšœśS˹#Wēč‘hĄVCFn҆œ¼%2|\¬ ‡ĪO ’Ɔ‚‰¢4ö dS²ÕĒĀ›ūÓ3„¹gęgƒWxnū~ŸæI’X/#ił˜ķCYd’]‚iĖu€ s`†æį腘(˜é¢¼*o„ņƒ¬Š\]ųō=?Üå7e|ķŁ½N„ĒBČö&]¶ö»Ķ) ŃčlÜīwXé E,'Ž\Ŗ6•¹¼YĄ_:·¬kljK|m{ZĻ:a߅$Dq•Øņń³Ó<÷ɽÅ4AMĮž1Ž‹)HyŲZ¶÷q“"Ģ•?ŅG¦ hzŖtźń™qfSŅXŗĪ¾ Ø×»‡Ņ9øėŌsvsiĖI’I?+ ī3øŗ™Ģįļ{q˜¤VUZ²2ÓW‚%Ŗ†^¢hbŚe‹°Š8(õ mū‡–hĖG”…¼ß†»^:ęŚųŹ%¶–ˆĄĒ@mFżČEKXC§†ä4Ģ[fßĮ1Ąƒ’šH½÷d] Ž©ž×ĆśpÆŽŠ“U‹(±cžGŻ/ ©°ą$ŚņŪB’ŠÉ,Yg;.Į(ÉQ@XøWą?Ґ-4­ūSlz^\•:sƒF$BĮŲ‚/TŽć|•)ZG$mČÖmŽ+DŁū’‹<4虅ח€…ÜVē @1D„õ¤KķĀĪ1“†ķöÅžxåįvq0&Tƒ0cŗÆ °łÓCæ~vbĮCü›Ž}#r,ÅD“OUL JPõ$łžŽ|g’Ąµ3^|Cę£c?G ÷‘ œ¢ ³õOį§€čHˆ¼nfu­‡µa°ÄŌĢŻXĘMŸŗć?śĒØ*5w€)ūr/N7ˆŸĮW]– ä4=ĀcˆR„¬^Fā~ źR¼Tyš<¼ X%€RlÄ^¶qå1±xÉq9*i¦BæĀF{8„Ć _<•µšé™ÕśĻ„£*Z²ĘŽašÜŸöJĮ’·…y9 öwE…żQ4lį!«õÜZ1ߗ)źYš²,éē1į>ž³l±ęAąŖ†5] ¦qŻåŸģ%2 äżEĄQž†o(LH [’f”ĶÖrū‹ƒmҧ‚*Yä görözsö“œÆ%”Vįćuā~²ę„Ōt .ŚØKĘģž2½£1éųāxĘ„Rž²>DõE­ķ•ģ~Ą¤‘ź]L.āčw €• †šĀō%½×Q“C³łŸłž\Į įŽEöd÷ōėqÉÅj­Č ßI’p696PśźhnR£™żČź_Ī[ ›'‰¾k°l Ņ”$F~$6K·U°sY^ĆO-bc@Ņ&œ*[¹źs(’Öa°ą,˲LĀ{ä6M‰eŸ¢P‡"9żŪ‹äĆH€ń2pÓ’,‰ūĮ ņ‡J’)Ę@ƒcī®Ī¢ą<’‘“ąWkģ`s .QźHs6×Ķp[ś ‚Ę­—Q黺,]Õą.[¼bq:zÉ>-±—”k]N4pčė¶¼>ˆ@f™Ę厼iČøm$ ‚ćŠ ź¶{d[ŗÓżLņE.æŅkø7ī„»U]cdM^Ī*…@UAįĻoÓź[ļĄō“#(}#ū8˜DĄ×Ō²ō5? ²[2Ä]żš–k7kü`žÓnĄ‚ ¼¶Öå@:׊ź ÅĀ<÷»ńLŹFY9³£iśŠ{9B ¹s¹ i 1QjYXĶtNŹ“–¶ŁłE2„߈’—ŲžGĀŖI(š‰„ģņÉÉCRŌIņļ5ļu\Ā”v™‡~Žāģ ŚĖĮĮI_y› ļõ›ēä,¬Üd` ˜.…YźēµĪ+-½½ŚT2×qt°&eŲ„ŒIlŽ’åt¼½¾†õ~lįUäüe åŌƒ62{ēĒ—„Ž|ķØ¶Ž…źOĻĘJŲĄA6p‘ĶōHlMkóGm|•m'éƒĻī\#Õ1T?»ĆÕšcµ,—7ļxqCļ©2RśyžKæ|ÕĖž·ƒ;叻;§:YŹC T¦½zCŽ6śÅ„ œ<ĀŪ ~„`Å^”tPG«ł ķ&{æKŠ=dqÖa:õĘO9_gœŽrHӊa)ā©·žę«j…²ę©Ź ī9 PĘuže]-Č)§?mØ lŚæNi;Ļ; @{øŲžnoAŹÉŌ£ÜśIŌ*ź’§ŁŃ‰²r5€õĒDµśķ2ŽŃé³C#ś1žļJDb<¹¦‹'‡Ź$ū£B³5¬BŠčž^^57£% uF–ƕD…ń±©€fÖv/†” _гҟŒį†ī•Q±ü¼bFćRpŽkźŽĄ|HR. Ā¢ÄB$æØø¹"PWšā\\[6)kø$2ć“@š|6/ß&Ēφ :żéö^ß¼Ši¾_Ž˜ü >ņé½ÕŁgŪóš0ź¼ć²'~dß3ÕĶ\–4¾^-mcF…BGÅj”¼GI/×HśtuFĆ®k_9”#¾“)›~¢ )”X…¤UN’ŚcÆ•€3¹ę‘õēį›p‘ēč&h訋u>*Ź»ŽfjXä'¬Rā~Cėę;9†|EäXVŚ7}ĖGRH¹ļź×*_΁p šāõÕ*Y¹2ŻÜ¼%2vføķT7©Į'Tn‰“®œ15Ō~ų”\ļE„ł€¢ēžÖ‚qū"܉™Ų`NŖ+‡_<6 ^4ģ¾čļ²Rx£sp?K­Ł¼šø«Ž»jö¬`ü”–1o•sA½j'mµŖōŻjn” ƒšY‘I°„‚Ā’&{ü<Øäŗ»¹‡€$į?Õyå®L$Hžū·DYsa%?)f-„™Q²“Ńg•Uƒ ŻFīŒĆ—ĮŗĮš²Čü:,Ś `ō¼ü’dŚx‹sŠĖ¶ ÷‹ŚnXĻš æĖˆŲÖ*¶uH¬¼EdāIĪG %Ņ,…šf–Ė6’+uEŌŖōW}Vƒ<ihxT\¬il·©MÖń×Ää½lŻĪ@֘æ9ĪĘČ£Ų³šnŽCe7iחi‰W)’]hSVN V÷ ¾sår Ā}YĢcä­J»šs›õ†Ń—*w”×22uĒĘhZ—Ų8ŌÓĮŹ©Ó k»yįæņ¦|ü$ÕŅŲå‡!Õdų£Ćœ¢³g™śµ”ĄsGŗō¬źÅęćĆśėMXõ˜“†C3LAy”ķŠ»üQ…éżq†ł-H€śæŁ~¦ƒ>‚åM„ĘŹĶŒ/»Ź‚×;U£.4Ź’µ}g#=Y6pŸąUAŸ±Ēˆ¾™dČŃ ‘zɦ¬°œ#‘ÅØÆéJÅ7^æUģäį˜Ž²KĮF‹©¹ē³Š&ō%m<&Ęm„L¢Ló”A,ĘĄdŧøP+­›zĒ%ŽęįVšó’GźõĪ{®.įų- ¹ļ° M¹ŽW*­q¦ :a7¹}³17†bč‹,cCæ;fæ\Ć`é÷hĖ­tŚĄ RźDĆ ĖéŪņ”ō?=roÅyŲ¹ąšRVĻSņV± ˜AśIŖ6W›Ī8C[ˆF!…_0į‹ą\åŬŲsAż.­¢„åaR#, nŽ>įŁi‰Ę7ž¹xŚ_)²XŽSov嬰wRS§bź]/~{ÓhYā¬Ņüś›B³Ō؟“hŃ,MjŻ€TEČępćŠ óF݃E µō€æ†¹…£3 ÷Ćąé¾}Ē͆‹a|sqČ@ĀĻøÅYdŗqŃö12ov°żņą³JCYŪM©¬Vß F•‡ĒłļGcż89œł$ĘV|YŲbYX‚šĮ 8IYäk±ź “£KH32N—Īąį²˜Šœ½P½uÅ5ą'įeAŃe?IcJä< Å`—ĻOvmm8÷x8‹Ń=†WDŹŌ4ZщBåšwé÷ūåÜŗÄ·U”i锟L°ˆŲ¦nŹ… hÖ`ž.m4Ńšš¶¾’s·ņ}}%buT™°HaÓŃŁOŚ[ß÷S|iĆB5’‚JŅ›'ÕČ n†[÷a9`ņӅ,ɍ‰Äģ=kø1N„ Ø,Rz”vE9ȊnÓM¾_ĻKÜlßjņ”v£zÉŪn‡KM°ÆäØ]•@¶t'SCVƒ`CžBŗžn½ئ•—‹Xø'::ä„—±"föšū1CWĄĢ‘h$zéÉžÓ`)ĮZ(—lͧ‚q`ĘŖ­_!†„0õ}°§ćy‰K„³*<b2všļ5 -ÄŹ–#b>!6pI‹iµē `ō‹SžĄ.HTę:fĒ;Rά“‰Ī8äžR(“÷¬‚ŗŚ(^F„”ӝZW£NĀ1v‘ ½ŗéŸ$W›R |4ČēŁŅ€’E–XŹ“g˜Ā{IyŅPIü{rDį*cõ~}"6ūؘ™%j÷Łū\~Jėƒ§_Ķæ3æM±ōĶ©³Q$ •Į$ŁÄh!Į6DĮ ¬iBųś-ņ©rzwóFŌäöģ~ņ“Ö8šMZ¶-]’‹÷ĢŚšPÜŁ}E.öpe„Ī  [-ĢāØō°÷ž ™)-Ļ\ĄŽ5C’;7uõo š³D\}÷ﭜ™įĒ~hīÄėßJĄš¬»‡²Ły(M5<)` Ęšå²@‰ eĢō‘¤kuĖ_æāD6ÅßłM5¢wģµl-Bl›ƒ µĀŌ%@6\˜ |Ħ$ Ł€2EÕøĆUųÆ(=tųF¬­®€¼ŠjÉBįN‰Õ"įB~vNȽ` Ų ø£”w“Śk„‡į;ŻĄķönü€Ž§Ėˇ’;=±ž+»=/®.˜Sc…„ mE?n~”J—Žž8ˆ“'ŽÖ»–”)ńųæpŹé…€õ°X:jo­­Œ¼åø0ŌA;Ćł­āJŻĖ,$N1‡Äh߯ Mņœ|ŲY4SŸĒóĪ“q_`ϊĒvjńe²Ą¹’Q ßAąĆofSnQŠū 1ū`2ś?æāQ®¼ėˆQf hŃ=\|_fĄG$–"SO}¼ĢŅ›R~p%ƒ`iP)µŸSń$ļ<(-jA ½ æŸ@BÉŹŲä÷”A¤¢¤™ŌN„āgņ: 70dÕ+‘BŠ—–9gqd$@˜‚f¦§Iń^ų5ØČĢ%ł„sŲ üAŖå°ÓĮČUO˜”°ĀēBynafķÆ¹Ł‹|’[­JŒ"¾öР㠜īƒ|3·Å3'm'Į6§—ö’WBō z¶ I„ažX0zBO›ņ2Ži?lžƒęą[GQŸV¼A;ėxĖBŹHĢQ‚ĮæQ '{ģeh3łsŁ–ÜĄ r I÷(-0¾Y*‰F 0ekÆ>¢]Eõŗx[d‡ æNģS}įõīœrœžĢµižÆiXC3›O Äl ¼«@Ŗ¾ÅpŲ4ū®VøJ‚x¦#L‹Ķė«mü”䃉ŠažŁč ł¬ś\žŹ„f\*ƦīÓæ>ģ€%E÷{ģķ³obż (ż2čI¤jfĻŖJµ_#†PKDįzŖć …’’3]?Z@‘yYšæGĪģЇ[¤+ć_ĶĄC Aā'aXśęˆa.žz†e|DŖhŒ{ŽR$ļ Š"„".*ßloč/tžY>åCVŲ¹›tE%›ė6|¼|ļéiø:Ppo×nÖvųŽēĮ_7ĪÕŪ(óō8wn.Ē# 7ąĢś B̳čŪ‘¶GĖåёņķęįĄž9u˜daFĒåąJ~Ķ­FŌ©)Rj¦…VįSū.Ÿc`ł…Ś–īĆĢ/r”9š .LJ°6¹ķī°ÓÖ¶ō¼sÉ=œ<īl3š@ģķÓ ¦¦Pē"Lz+PÓūŹSҁ†žtśŸR#i…Ęī==|SΆNš~+Żņ¶ŻŻä½Ž>ßĆ.JiØZmń§ =KśŽ«-­•Ņ»+æ“(­ļłŽæˆĮŖ–ėE!T „7±ÕĶŅÆ„=ŪYPxOŅ'Ķ.®¹ļ+#éšÆ¼cå€;(ń ¢Ļ±IBO®šæ’y’\lšašūȞ–tź‘Ź‚1q–īĖ żńƒĒ”#Ź:Ź‘퐔œ¶DŌ¾(8æÄ»¤|‘°ŅzO[cxś?…†įŚĄZ2 dŠ©(.z#"H›+Ŗ¹…0BDbŠ£„ź¢ <–t!™öD+ę E9ū¾OŽ~=ŗIm”Ū…Īņ¶eéĶž ņ¢üG™²qļń¬{aż„vė$܉Ÿßń]“ķ’œÓßŪģūŽŅų‡…§±£m6ĄĘų$² “F”a ŸoŽĪSÜ’ļ2xŽI®¢ Nw –øŲnQy¹ Śžåag±PDRŁĘĪ¬Ór “‰’0ēF{ö¬Zqk²¼v¾›Ńń5zƒŁ"‹17'e+•/Ņ蕊p㐨r…Äł` żŠäKsž­E?™•§ßāl1’1^użķ[ž-Č·±&¦µe`%²ńń l‚d“×ć2n8=Äé2ččĻA·ŅÆž@½]ü/2^Ā€åŽP'I“²ģĄ'qWĖ”ģo’«œµŚ(Š>9ŸÓ°8H„8dåė’rĖ:¶øP£ė)sQ@ģŸB°ŃŖåYŹpĶR6•Ø/æėĘ@£03ˆ­OāS‡ĆčžiOŃķ’¾”üy7Żöl”Ō±iÖØ¬±ØüŽ«Én÷ÖwŲ`,ÕĢ?),#t„°ŗEŖp·.iĆčću&?š+£18–ńž±RĮŗ=æųœ’ž}$aø™!ē=Z)Qb7I:²3ļÕķ¦ŌOFlĢ'¤·Õ¬y'Ą¢O§¼æŗĀtue2™RXīõŸź~²pšœ°ŪÅ3!­Ÿu/ģźÕąŽÅĆ2œŻ*KŚ„§%ŸužČóژQ&üPæŠUłŖś÷’ œ26ß]+1*K„öžģX@oØPWó+n4D{3ÆÓõFęIŲYhų'‰mé[‹‡G«Ļo,ŲIŽ!É ¬óŒmš‚øœš6e0uÅfQl#§G¾cČX`wǾ³ķŸæŗŹVØoåITrMĮĮ,“ų šlż˜,Ź©·Śģ÷¾™I^eÜČ@3É$’|~?G€ķˆ6€GjŖOb xw9fŪ䱅t¢S,\«Q4o­IņĄŻīL–Ū0źż ł>‘”‡µĻb]<÷’‹ųĖŃŗhQ邠$€†¼wĖ~Ļöüa·Ž\޵•Üi oųõbō”BOż‰č f.ė0A?š"ųŹpĪė°żu@v"9qcG=“]zl9īē—JĶÜ}éŪB“W²zŠPŻ=VY=”?f †ēæ¾^(<ķDK{ŒVB®4ŁGń„9™®[rĄLVš\Npä%Ū;śŪHū³37-šQHn½oŒ„£©čłMϳ8sjI8;¦F&׈…募3KF€ČgŖNZ­9©>™Pģ>ó[„š8™_æqū$ (#vPŠńb„­?¢pØļ‚ołŸGąµOhTĖ{ņ8Ežˆ“ ųŽuČē†žĮLćķ!d”z>óŲz¼° ÄĻž’Z^ō`Ķ oŗA<ć?ĀzF d$³0ų'j­>ŲĢ‚ęØ?įk«čb“Y»ś VČiŠ,o£„”\KƑ‘ĘCe~ĻżŻayŌMU`Xó‹wäÓevŹŖ·ō3ō Ŗ“¤ŪŲčµö‰—Œ’ #ģ½<šńōM¬ÅšI—’kĘ{•Jź(ś|g„šÅ ­ P†önŻŻ¾k½„YjĀ«·Zƒ@ń‰Ś„»ĮNź(p×ā3{źSˆ3Ég·ķ¤RĂŚV GūĘĢzĘę£D’‰čUŪµr”ĘžW÷ĒVņź|õś†˜{öÓpĪ#Su0_[„i>+øm?o˜ń*޼£łhĄóĮ0=/"ięłeÖøÕRw;ƒ^ō­$GźčłņQĢkO @›©K¾/‹‰]ᵚr\ÆīVla2ėDĄ’EpFō¼“ƒ°GcOõ(”QŚŌƒ¢t²,}?GeÓ ėÓŚ™xSąÕؗ¢(…‰eĄ3[]ÅiÄK”¢pŪt„åȋœæi°¾T @F’æ•ļrrŻ›“×#ūĆEś˜HĶłG6ńˆĮÓٱ ÉęP éwID?Ļ5tÉņsDq£A—ŒūāvŠ÷_.üY‚Õ“ š§ ‹Ņa«Š#į`ńvkvoRS  ¼ŸÉĖkæE”šUōżųx;- 5PĪؕęķkM„ši'£ąT+„QķŻätŠNŹŠRŠć§āCõYśšFć/g‡cń +ģ›6ó=:gb²’¤|žĄŚ5rŪčŽ]÷Š8 €rᯠrmhńeöEļy„Ķ5Ņ…>2ņuNʖ–ä_S±ōĄ°¢ąč¬Dxćķ‘S:ŌT͊Ø>¤]n­Ÿ»:¶"£Æä;ōЬ.W(”×°+a ’kIšÉńˆ D³ā]W³ÜKP®d ōÜAiŗFM—…‹’z9'å•ö7‘·'PQöŚ™!ü®4’Cē\šs±ļpŻA«Õ€WčOaˆ oj{ōx™NĻ+ƒ†z”Q>¶£49Ä sæ—ģūuK-Žņ ‹|ѵŲčč/;07ę’»¦•–_/ęņM·PʏV}§Ā‰jĀę?QSlčšSč“ģ’3QÓJ%׏:Ė)°leI›r^ĒKrõUC¾–Ž0Ą”rh×±qoō3øH…ō=Ļ„øAg^* ųeÅX-lGV’ĶžŻŪX„%C;5K?óÓ®»jw!Ų÷`-~e(xĘb±µōź?øJ?ĮĶg*QżN“!UæūÄī/æ0Į‡EƒĶ„YI¶ąāłāęA†4˜ńĻ·¾;[eōT?מĢo%×|yš Ź_OF±Ó±š†ä V5‹2ó¢üeŪ—%|Ņ“ź÷sćFžQ¦#8l9t&"ĆŌōbm-7Å÷/’‚H æų1=X%÷¹Ö²XŅ&”]J ZMo¼š™Fƒ„$¬xźx—ÜI‚¬ķWlaĒ7޽]ĘĪ«”BBBĪ‹¢_Düqß»ę‡2é j ">+œj¼ €Ā徚Œ÷=SŽBdzoD܊zį–ź ¹˜ž[ÜŻ­j„ĖvoaŒų“ڙ• N[£üŖæĶ36$Ā?õ&rÅ/¤ńŹnÉńäp\śH[Xšē*H•-ž¶/ˆō)A|*„81=‰5šHmāŗ”ę0&­f8ė÷1ļ\tOŸ$VŠ’‰¦]bd–hźģc{ėü¶tÆxœ^ž… š<Æį&ˈ`5%’‰®Xąh¾¦/d- Ļ­”¼udņ„zĘ8"Ęś:…Ŗv»[…^ī襟ŲzŖxˆfh)Ęw¹-T/~=ʁŹ%žÖ+Ķ'¬ž ³ Ix©ļŸģxr'*ČM†æū†}a(i² ØØh‰jyn©Ø˜āE„YūŹX±Ś)ė¤MŅ4/¾»uETGå?ö‹+ō,MM©ĢČō»3„šdßß{½£h0©idī~KÆ”^]…¶%īÖt³LRø~ļ&Xøo„ øP=x)M ½āB  ”-ż7¶pYwżų ‹Ó}ÆŠ„Z˜A†a.Fģœ¢™”}†Š»ebPV£j2•$Ąq1ė:-9‚»hˆ*tūŻ›š7~¬äŹŅc&Ŗ%8‘ꇰ~JUĄśna¹!?¾ŁŻĪ%{Ķ F÷)K/¬­m·šŠ~śLÅÖÆ£)éMY)Ņ©ąuŅ&¹ā’āÖÆ†<Ā%rĆ.»,}Ə‹Mą±Śd"d„”Ÿ3éŃA ~øåĻN$=ģ”ūįd¬Č½©Š$BĶó“öŠ–H$iIKÜ9Ź5ŲÉ …¦(d‘;ƁĄ3ĶY!­ž„¬CķYĄ‹Eiöź…S۟ZNX#@£ˆNīx'ŁžpĖ’cķ‚i’> ūµąæėE¤ĮdS;SŽEŁ:y+ŽŹ"‘-Ć»€©©$30\čČČåŽ6{3˜¹LŹŠł[6‹«×RŽc ?&ÓhIņš‡Q ¼s©wņL|ɄWĆĆÕC•=WYU6*’+SŁ{戜²[ŌvŁ©”› ½Qģz%±ė¦:_ŗY •ÆRµJkß±ÜłĶłČĄsŽgdĪ·¶Uw@"śé$I€9uigZ%gØ b²h|VóɃT×÷$dš[-“øŻ±FJ»¢v$¦Ā“£öŖ`µqP[¬Š“ņCŖüļrKź“–Y|LLLI‹l?fīĻČ@—[‚•±eó3Ū^›ć“ jųzPqi'œMgRF7iCņŹ!ŹWĢhiĄā܃™u4÷ØįÆ įĖāŗļJōŃ`éM‰Črź`6ĒkƤiOe·dnõöķbŁįīŪ Ń§ŖvKk›ß‘„$]i“Wueäœ>XQN5׎ÕėQšĪAÉZх!øf?wšĒ‚u§ ƒ`Ļx¬¤ņł¼ŹßÆ ōb“P—õŽ}ņ-©˜œ‰ax抣b4{;¢ņ®ķ°ćŖ!ÖĢ¢²ęźŪL«GptłÓ"†{¢Gå6ԟ.ŻåUĄ©D™HĖµÕśaDaĶ-9ŒŅĶJ;(įæZķ–ĢénĀ’ńĆvÓ¦óēŸĢÄXäp²Žģs€1­ÜH4,}Ķ•žĢÕÄ/ØkÓā²wR3oׂļŲfZ$ QBZ­CzäĖĖ•&‚iæ/FцA›Į:63ż­ÉÆ4QUv’tåķ8IWó .D<ā7Ŗ³ĪžóžU‘+1&æ0$.x˜Ž~¼"Š­€sÅoĘ(lm”dŹHGć7tėC„|‘w\?`9¾‰:wū…‚3č µEb= +ĄÅL ę£H)!§˜™żpSxN¶‰-7^“ŗ©¾5æŠ)WN¬ž =łL¦:“‹ükD‡ž­Kó>°BXH‡*ĶĀŖėe’O`QĻ{ÓzPŻ,>BČČŠ5q.ņåØåNĆOĒ~܉n>•D–g@ݾ«˜ģQĪ@å¾R45Å0sˆBØń“ÕŽæŖ”N@ b††@Ćmh¶-Œ·(ߙ3·ŃĖÓa%ŗ,AÕt…Ģ!ö~•Ÿė²›Gʰꔠ„^īy°ŌÄr²¬¹Ł“‚½Ū6i6>włęĻLG¦bgq‚€Õw`GŠ œ£z7lāŃ%Ī*²ēłrKżuLb°˜·¬‡¢Å>~äąülaŒ–Š‹y5$‹=””\HtxĻ^:ž*TŸŌpR­š‡Ē .ļ=’V4ŗ>óĒ>Tõ®ć »¹ 0#ß³PÆŚ4@R™5Z‰op16a°·0<Č·h€¹æŻR™6p³BFęxÉ% @~ąˆæ {2tÄC¦¾Ą±šŖŹEśŒEühącąćÖųØu²­Īy9n±4¬f9ņā/†O­dŃ+ž¶~Č(ā¼Ą»Ņ6ńˆœ±łÖĒcmö=)Ē™§wņŹĻuåj¼i±"Gü3®ź±j÷fĶ©@ˆ“(ą#¦ģς9MŽ«Ęƒ­Ō™ųI@w¤‚™[Xī-8ą”T@$xA„²óu˜*äW…¼~^QŌ£÷é¼³šĀ‘ćd˜3Y%‚Z7Xy½ø×5€ēw"v¶š “AÖrßi(¢ö\g„L“ «Ł›9xłē|÷]‹LhšiF‡ö¬ä„ÅPŚ™O…Ī±ßƒń õ‡®[gĘvźįĄvSÄūŽž"˜Uµ(Élä`B-g•žB†ĒN}»tųdZŲ ż£WNaśł‰āJŸ²B7u®yż{嗳V'ĒäW4 ( Ŗ@šĆŃ”ŌÅV֍£MHÓż74ŗdBwDócwWWfF8¼gEhĄ{ØĢI~4b¦‘Ž—=/;1¢0ĢÓ ßÓŲć¼®H\-ńńēlĆ`X¬/ź+xµƒeKŠ’]äŲęšŲg›D"Ā×jK*49J87åš"tµuĢé_­~Ęv‹šą`~d0GZf}ÖKf@šĢžœe—ŪfJŠźUø!–t>n?åN„'Jņ9ŚO‰w‹·i Ńšš‹›˜L¦ŪąŪW!‚nx¶€XqX" įåļļ R( ³-q‚o'@üõœčÆå ČĖ‚—_z ü ž·ŪÜŲ»čåÓ« Ńdøż!]ŒĘ.5'cĮ®v«÷3}ō6R±RT‘G‚Åž'żø’ƒjƒ–yÆ®$Cš£[.Įī‰Ó¬‘CĒā±3ƒI“–·zTÕ×Én©$Tųæ†ČĀŻ)7v wn6ų‰³'!Ņ]—gŻÖ »Ć靓cžžśĆPńŁčÅ/É4ø•ń? £öZ~G˃ŅK«å}¬‰ŒĮuĄÜ*y–Ÿéłq%¾‹$2¶‘\!;¹\Vļż¼z3’īųHu5†zY}‚F|ū‹O]īŠYāē&ŻŁųöĖéJÆņä>ĄøwT]걳˜kģCb7tŚž· ‰ū됉ĖBžčˆFœQFø”n›ž‹Ō²Å[[x°Š36ϲP¹»!„…r\K)Ü;‹45°£b&‰÷ņ¬Bę0Uš9dļhcI€īŸ#=y›t¤ ģ磔Ę×£Kņ?æ*$œWtģ€"-xŗ•y 0ņ,"C6;iŠźxc¼øf£’½;‚ƆÓĶ›MĮĢJ G‹ŚņE³H"IF œNīœå("čEĶĮ—¬Ķ`žšo—Ć/ž[@h—>*–5Ü}ō”L’ڹ±Æ3öō͹r=mūזļLo;' lāįį–J2©“Ębåjńäī»i4ć-Ē@ļæˆx@ņVgiä'€\(u»–Ē.rǘżä6]»¦rT)XGĢrĀō÷²ä”ń}ŹŽÓ·’0¶Ž§E#š(Ī幎 ĮzJ)LzMČą¶«ĻéÜÆ&B­–ŽjŪ90&y¬÷‰‰ŗdWū§:ŠķYRqdńKA"(”ƒ ‚ˆ‹jb‹Ėø|?T7ÖÅzßīļŲNYčN”sVMU‡gĶ@ WZAރÉ`gł†óģÖ#Әė2i?å0GÉ!Õ+/’ óŖjCgŸJš^tŠØ_źŸIš‡ōzĄ(Ę ł‹«ƒ¶6·vžŠŠ‡©hFŖ]X9x]uDå~-źnęæ!$vć†=zįX\zž Žf*^”ށµ=éŗ“Ģ’”é|‘f¬šó±Į-œ2-(</Ūór"×ĪS·ö+ä¦.~ćqg`TIÓzм”&ß ‘øÜ Q’”w3“ńö§ąĆPHńtlģ–nßå‘r·*½9 É.”ųˆ2€ ń¬ėdIŗõB“ń(qT ™ōóC’—˜)’Ā`ō4ŽŪ,1›Q4yżĶ©8lŌ£žAi Ģ“õNÅķ"£Ÿz„Ŗ™†f#xzʜń÷rhSŠŻ;Œéœ¢’ī,ƒó śa'Šņ¤ĄÖŽV±”ć\€y%ž ½Ć”®Żåµ½š“ÉųŠ‘Óōų©üœÅŸ°‘®°®sŸ= ± œ~¤¹)ŠŌU¼9E£ÅiÉi–Ą? c6a±<žĀ4„éģĘö‚…S8¼Ł!GjAŖāN%N„ˆųRk3š…”Ÿ®=ĄŃmUäĢšĻą6ŚUmūķÖ!ÄZŅm”„ lYOU”{žÓc¶„(č98»IˆˆĻÓ8{ņ;qÜJś†NŸLŚR7½Š@Q|ę7žRū·‡Łžh˜Mߘ’±žŒŹÜMzŅtnV†Č#PŁøÜTą=bXq-Yh2&Ģ?ęyu.ą1ĄöŖ[¼åźĆ0¶ÅN+ķ¬ß[lI;Ć•ŗ§¬³,Y&:"Õ43•™dLŖŒx7došWūщzń 6łŖ !Ū(‘RäA„źŁ›y;,Żd=ˆķĪ5%±µJÖvÉ[&ŗ4­ÕS[ŗuR—a*pĆ»‚žäyŌč!ذ’eY¹āčøįĻĆ}ĒßT'čϰˆe§*”#ż_Vä®vŌT.H`ƗāP”īEMģØ%GŠyä63ƙųt›ŻmĆ”yƒ”;i.ņ“r,o’į}e—Õģa+$¹S`3F¹TÓ¶h IāåjŽaĢ įŽDTÜ~ø”J‰mZŠOüvŶōū®«SķĢŒœ»#1 Cd…Į35o#‘¼Ya-$&š `n®ļÓ~ąUz)'Gųw¤©P1*RzŌē†Łü…k qio>žf‹HŽŅ„‹ŗĆ~Énóü."k$Ś ęŃ1[oæÕe9°xńaj’RĪ>ģQĉ°!?]ŲÜ÷„(£Œ~§š¾|Œacųd^X0Üę^ųW¶r`cÄ×%ó?"ÅYŲĒÜŻ˜7§OcÆŃįėw]éõ¦F‹9éņ\½«OÉʔŽk’,|Ɗ‰»>å…%8Ōj–­kAyŗ1‡b ć- ä­E•å9†āU`2)ė;)VHšÅ)žeQŽŠx†Ż¹{-œŌnšQ|As±C Ģ@;4±G.³9ƒēDʀ3—¬éē#• ĢõÖˆ,Ļæ³/UTĘo<‰/“÷do˜yG®d*/P9‚ĖD­Ÿ‡Ųƒ„ēųmāĮÆ˜ŹŒĖ‡yÓēD¼mÕÄ^ż”ćš›žQC¾H246}ŠˆtĻ ļlĶ?ȅś čvĀøŠŸĒ^¤›%éßOIėiš‘“ĘFČīšŅigŃįØÄŚŽgCšF¤\ްl¶Q^  µzŽģžgó£*Ų=ˆ³lVPe»ötŖz”ĢUÉWqsų5ŠĒC”;¼(tń#C‹'åń aqtæŃåÖ&Ēl««‹ü£u—8üęŃ­A.Ķz »×j zß¶‘‰*4³Ié‘r—s6Ē<„ØÜM("x÷ «L¾“ĖSJg|ĶŁ’Ē䯤ć4 Õš€¬f›īĮöWzƵOr(gĆt…6–źįéšqÕTż?ŚŹcoJy&޳­>™t ?7ź5Œ jŹčZ5jß.¼·=ęŚŖ?ćfcˆB VŠ m’AŸés*^ō£Ÿ)@;¶ź–Bųī÷jaމÕMźB<ĮƒOŗń‰©[¦%"Ą­C7ŃŲóSeł]Å㿯® 0=Ó4b M™^NŲō9¢Yź”-¬§'"Ģa&Ųz\¶aÆŚšé ż+ī²ĆV”’ųOø„1#Ū&|c(,s ŠvĆSÓ¬yrʄ>5‚÷š ĘmöųH¢Ķäėśl~-¦Ńg€²(š& c"lĆ;øÓW^„0B{cv߃`х—ĪŖź–”fdČ+¹¢F]ž†Æāędį•ŃD’qŒŻ~)…Š@[V{ņbN–ēŁö…¹ęÄÜĮœ¤āą—ŁčĮwÜĶgÄ'’¢łŽQ’ åˆ@6„‹r(̹‹¾6PžV؊f 3g}ķÅŲIu¹WsąŁ‰‰ ‹”hhŚž~½ƒŽe“hŠęœ ń…byą4 0ģœ{’pĮ1^`48—iH^yĮ7݁ģĖLJĆ1ž$ńŃÜū>^Ų»_P?"’łBĢŚlÉU–×›ĻÓµą%r'Ų3µ¢EĀ/ó§hĮļbBšKtĒÆ?+=T×,ŽA4.N“å6zČ>® Ą‚ŲsöVEgļsQØž1«-.8aZ}DGPBčæ7ƒlą’…Nć* ōI;ĻĻĻ!Š}ĻOe.Čåķł€ughõuŚĢ®F<¹ x/Œ Ų8½}6SG3e«oTRŅ“ž°ALĒżkŸ>‘fŌ®źĆ|wūa÷„aė"kńž¦C¹ĘOsÆ5÷źM@KKzń±ōK”uj=Ig=ɦŲ`ÜF,čXČvj”.†I§¦fQr‡› Qb—Oąöy2~ŠØ$ £ī@S©G†žé÷ƃܠJy†CŅķćsk@(G®8ķœ+•RąČmįźĄ|o7Y“yįŪ€}Šx%< JŌ£Qå°¹d5§„bLŅųŻ $•=šŃ’9=»‰«ĻŖ„ēå[i§Ocži^ÅG€õāąŽ˜7l Ēó³Å~×ńžp‹Źex'V$”ĆīÕw3E æŹBģÖ¤u%Ģ}ķ#†ˆG±„°ōł„OżÕĮ~Zž‡©v’\šYŖ„īÓŽ»Ģõ– “·f!"’Ž­önŽAć&zĪŚ\(Į—“±…f„×ā9˜f‹¼P ‘7@"®’`'Šwɍö°oź`)o/ųż†–8oŚq*ÅŖT™ ‘Ģ&ŃäĻ ®Ō*ŗĄ5^×+5$Ź2ųœø5 5Ū„ ųż^Dķ\¹p Āŗ‰H°)„S¦'få±>ÄVŻ‹£F g{ąkс' Ä¹õ—b—”v9ż“a0Źū½Lˆ„'¦:} …ßļCÖJ,|D éŸ&ČāhPņ±įAĒ{‹čgą”.V›Sņż&Åhū#Ū{ÕIŸ`*æž@rįMŗ¬ ~Žf$Y<š²ƒŽ¶±įŠŁŗöInĪõkŒæ«ÆP„¬ŠæÉöGxVęŌ9ī"[ŖP։¹é`_žEk{ÆŅ”ÅĪ#”‘$²ŠemģSžķC\N%ņ—öużkUɾG]OCֆ{hmBŪögĄ¬Ś4N{9Ļ"[×¹£Ń¹lĮŹ”ąŁø ŒgtašWųēާ/ÉĄ.Īė‰SZ‚ū‡GµZ%Ą‚@a*Ō%X‚›™¹]²HŚ×žBČ£|ßĒé±DŚ“LfG ll„¾“¶(r>S\@l< ³G°Qćøž²Ä$V'¢Å‡`br ¦Šo¬Eļs¤°wxzBõé ’Ūµ\×YąŖ ÅĘa&•X„J¾£ęŗ{D:ƒ©łŒ©I¤·ü)53’Å XĆ%B¶w–æ~£vŌ$Y1üriBnæwHßNU.fŽv·Q‘xĶŃhųųŚ`° ü.ķł{5ĶLõTŲbųė¬õp¾B͹Ž[ärȗrž²Ļ{9 Säē­!Š%Ékr}ʌ"—AżœŹ7•ä¬éd>éƋZĢÕnųX üČÓ؊Ż+v]5Iē"*š¦¢7¶ōŠV&¤µĄc1\_Ü1æIZgPś‚å)–¤ōāŸ5«„–­żnCv÷qT¹ķz%dÉ éŠIzA*^Šm†Bٱq|‘z¾”#1/yØ-~»ńŗ³·PgöĢC©Å—ĒNZĆĪRš÷cJA T¶—¶>>šÖōy# KsoT:ō²‡©tŪÆ³Ų©w}BØęvēöVÖBjåŁ÷Jņė½*![>żMŠRüPą}]+Ui—į¼½; „Źó±·Š:s>_ą-¹(‹vyÕ«»Ŗ¬U€]I’W£1®}6ŽĒ9–Kf³dJrņŒ!P"†Õ­±ė@(ŗ”I-J“1bą©ėĶ£e””§“ŐK¤¶`iąœī{OŸ×ß}eƒIØó‰ “Äī<:ń -»šRøĀ$*‰dĻ~Däō5·(ŗ”ėŖZšq“FqśĶ9VZ+69ä,|õó£‘ÅŚ;ņĖtĄ`2]*Š u'Ć^x s}ȱāl‹ˆ«i+Yü`ķ8E9ŽĘ.ĪUi”‡<|Ō:Ž»½ĀóåŖÄŒ¹(HĖķžŪĪyQ‘?NŁŗ6&įĒūaœ&ĶżćØ“aKP£ōe¶L¹8h†ä¦m~J0Łl½«®™5i`Ż?’lé†1ÕPˆ]՞Äg½|hļżØf–8#Ķ…~f@¢äß@‘^¢}w=A“‹ŹĘÕRĒö=“;r@y–½ƒ›ņĶį`ÕD¬Ć®æņꊞyՁ3e²2ŅD¬5%i)…_ƒ”Wąą¬!Ž„‚22ČĻbŗ½!ķjż€üŽ1ŃuŠ@ŽmZ½?ņéÄ唌/§€:ސ<¢|=Ų}•=ȵĮK%ĶńŒšż>Ÿ¦Ėµńźé“d6Ö ]ĪŖ¤”“ØhM »`M\kgė;Ē×ń•ī’“ićXk 7ŁżG?ō½`!vÆČ{iåć½ž½$0ŚęŚ)cæ9rŗē¢#ŠIÜ”¼m©”_„ē)w#/¾d¤Rń)Ic¾½w™ĘOÜQģōŗ`qdō•$æ6øC15?\`€Č±¬Ź æ6sUĆōµT‚GkżńÖĒČs äl¾uwئčĪ'гõ`”m=Œ€ą® • › Pé¼*Kȗßø}āL!CK9ŹqŌE8~N~Ōõŗ_$æ{?“Ķ+&¢ –āĮh’øbÕxRq¦ĄŌvİģOœMļķūÓĄ¹f4’ŗbė£*`O%r(Fń Ÿ“ŪIµ/Ÿ-{8œ)6*2Õ¢‡vÖä*2ĀѱØmŒÓQÕ=ÖfĄßćÅvv®ĆR1ŸŁJį²üLÜPÖIkĄETÓzĘē"Ŗkt‘šŚQ…W·Ąü)¢Ź$Ģ-žŪ& @ļŚ,¤×Ä5Ä ĄžÅ·ˆæqēd`ł/±gõJS‘€¾;ōŻā36ū‰č(L¶ĘŽ6E“z2€ųmACšūŌĖńs$ģīq„źP[ž’­ūvšé*+ Ó%ėr’Ōyrī‚*µĀ]O°–ŠDżTP«Z)Ńcš]»†Ó7S­am‹®|Ą£TƀŠVņ†#ĆaĘ6rķE;*s z‹ƒ¤'+.†%gÆ®KsŁ;[_ŠR|9X XÆ,‹ń58Nėśe & Œ ĄN‰Gł§¼2‘?°“”£‰¹Ü{K,ĒEœ»÷~ł^ėśŁ–„æXśł±“ć–ܽŠ$cŪ=†‡»ČYüģ9Ģ4'õ »Źćó0“‰¶hÄļa4cXTā˜OŃ|žąHCĮÓČr譎“o§µt§ś“ŌŽņœć„”+ü klæŽMŃĢl;ķTį-|Ź0|²sžįUT‘UcRś² *!klĶr#ņ퇻‘N6łŖQzlӟk°g•­ ^\@ŽĘ"×ņƛųÜ6ēbƽJf«‘<™lŲyŻ[žl]1bśL ŚzĀY$ÜŲ¦!ŪŃ\ĶXžœ®°ęqĄ€e ¦Mŗxd– A.kYQŒ7÷w“¼ŹĪƊ愌YõwE’Ēo©čf]¼”qIKåĻ|öė6lP$y7f`y–!®Ų…µrģžĶ²żĒ Ę”IŻzÕ”^d Œ“ čjDŠ&Ž‘k_ŠżäŻ.@gŗ·ĢSę=µ€éby=$Ć@.šŚł.y×x®ŃrĀK[;ąĻ©(ŅęµĆõ(ōŠ– ķ[(!Ī’! ŸVn—Q>ÆQEµū“JˆŹY²Z=(B䐬NdČö‡f9ŽĖMņi Æ;R"艁P( ōŇŖrz[įxÕė8Ė÷ ×_ucēų#µ`ź1)?4Ę?;Ō‚ˆl¼‡ d «ÉīƒÕY@č>IģkMFŒA^ĘÆ”Ų‡gu;©Ģ.1%£åŽ-?“ 'ńt»Dm-soL“ėÉn(Ņg¼L”Ȧŗ]¦(1¤¼ĶüŹ®g^NQGŒ¶ŲAÓZS! Œ$²N|ŸÉ/Ž,G*&6ÅķE›`Š® ņövńæH¦*Šķ÷!~lĀ„Ø"R¶2Ål”ߗ˜Eʆļr”ģ~ć†W|éŠÓ'ɋž9 ”§™Ÿ&G\ŅĖ|‚»æŠüTįUĒ4*e'Ų XӒ)ķÄw‡łf|XX‘_§Rf¢«Œ\¬łóõ+‚=[Śģ%Lė8×~¢[Öū‘]m>^„ĘŹĒĘóĖAĪ…ZP>øĪ«Œš‘rDĘ v–Ü!Ž’G…l fž°G¢»,ŠLüró+|żAd>V@Ķ®UŲØQĖōŽ2€ø’h"ćó'›zŅŅyLY:q²Č4Öņ0!³*Ū7wŖĀd aøńHØä±®°æévŹk1ććī­‚"Q<­B…$o¦Š;žzJSÄ`PśŚUBé›ėŪ–źOÜŃA°5óGęØžV£™3Ɔ~ĒM–"ŹŲēį:b–Fƙ˜8‰ųÕ÷Ė@eGĶē÷ưz ·óʉ0(śõRčŻ %”¦×yó“8HÄhr9Jʃ¤ƒ ; ¹ÉSIyų2؟{Y ©qÄųL±²¹¤ĖĄpŸ’Üķ$“ßąEŲµR±¬ķ(7Žą‚œ¶9Ć<‹$ٵ»lqf‰^—°7U)6ˆEŠ©NH'»j+‹šŽ\:¦yÖ*ĄńF|5ĒŻ×’'_hNk^»fŖKjiQŚ#‰Š· OǶÖ,øŅźŹŁ“/†Č`•vX¬~­¼ŹĒ£8U¼éŸØ·4Ų­Ó©.žŁŚ«Š °Ķ<­Å+ł“›w%ž’(ķ@ŁY`ŗ_,Un9 ĖłL©¬ø‚{żFu%ĖBåxä4½«šv‡|ktÉyõÓøjåFÕĻ6“ų1@ólæšM”@?eEŠ; >pܗkJŽ$¢®šcNj¤¹ŠA„šSU@ßśj”!U½ČUc‰[CH¬Žnx0ŹG ‚šq"&1—¢!³:=°üJ=1Ģ«Haģ7Ė•{šögŻ}~Ķ>ŠļSÉ5 ńŸI%u65k"śó»ęŌw˜nĄyŠ šMųiÉŻ^„¤ŒĪ˜[¾ššŠo ~4ślæĮB°!…˜ˆ×†bÅĶJ(,ę\uJšföŃ÷cYŌ‚ŖGžŖ!ś/īVœG€›Z§¹ź¾3h·­S Ķ'†<™ū'>œOU›}©‚` Ėl[‰čē’Éšn„ĻpĆĄܹØÕµKŪ2@4kŃ7Z·ž¬äX·yļēä6īķ{!įaōĆū½ ĀŌ»5Ł.[½“>/ąWÅ/kæJĀpYŒ»C÷a;­6hĢs6UheŪR30«ń ²n/NÆUžżįł`7ų°½eƇה}^ėū-¤ģ%QæÜĆ{6©¤r5ƒķƒ×ŠL,‰Ž‹/!vhóĄ<šR‡@P¼'Ćk÷7ėOķfĀŽ›‚U€Ś=e &£°A Č<,ĶLó¶ńZŸ¶†6ŲĻÉ5į’“Źń6ŸĻ07Ōō²ĄÕ »6>/qiŽ&®w¤ģ·ņ7õ“ōÓģüBįĄ’HńxļŻYHQ!(dPŻ6Śs¹R:łAb?¦2æY»Leņ䫚0ó’DQ’D2df@› JN”ų\9ĘXŪæ¶%‰ŪōĒŖ'7±+Œń§–¼É( å„ü=¶×Ģ­ ø:p.ēĒc łöøP> Ū‰’‡ĀūIQf§VZQž<˜|¢Bø>Śüē»ĆBLī«5– o@ĢZœSü‹–ĄŻ΃¢~?8“j-t1,ٵīT|‘‚J"v!ēV¶ tĆ8E;ɓ Å–mézäļ_Œ)WM³ŽwJdæ@ō;;»]0é\ęU½ĮČbb——üĮVś1x»œA†ę’HžSsv ó±œ~{Ų"cÖ>`Œ«ŸUpQŗc'VĄ9a’Ė—Ä>ŌŃ;’[ēR ˜RlJ<‹¾sk†/©Suž0›ŃF}‰|ÜŹtć•ā µ‚L®9L,4āTĮ)<܁暹§’C”'•p±K ģ﯇gµļk9‚ 3ƒ ×åE¶{#w0fĀŅÖčźÕÕ%ʳū}øDŹĒ–UgŖ ąĆqŽ9օõ“㽄a¹TčUī÷"L½7qnķ²8ßF23e{<õ ›Č¬“߃ĻŲ%]Y*'ü%ą NPĖ©¤j‹ā=ĢW@ ŻŅžŌ1g÷TėYł=ĶÓ½drĮģ™Č¼°U>[ųÄ7[’½$ÓōŲ±ŹŽx¤H϶oģćˆ|Ŗ'žMĖÄąĆ"*‹`ž§óbL6?LĐKńĻĒŗY[®ŹdoćS®×˜ļń«3>•§—­ća—§5”¶Ō޲⠊ 6d†…Čz€ŒŅ*ĆÆ”ädX¾āå: ¾ Zh2ˆ~hƒ^ØÜ„:gÓ«S÷[T| QˆøPC™ TS·žœĒš”aĆæ²aˆŠZi†°bĄ®6‹€vcϽk¤d}ļ§!ń^l^ōNėĆ~`æäĖ'™<Wy”$§sīŻŃŻ=³·”“ī”õÉ5ŌŻ@IķQ IxÆjcŁ`,]j-¾j”Tˆą®äl"_ź°‘~ }Į(„†XnFŽ öv1ž Ⅎ!ō|vĆńŠF/Ÿ…€Ōм0­5…'óčņĖøK˜,̹-ß„üł”oū… ßŌĪm ŁŚ^?"Wןū45¾qZżU“āt`yłā+1@…‡„Ö×Ē}LX4‘-o~Ytk“ĆXc¶šL÷ņŌ’«ž-«ƒ“a,ųĶא4Į£‚iä„L n †]9E{ž‡q7ņS¦Æ>³~· ą2ņöW-P«f :d°BģVĻiÓkÅö`¹ ä“ü"Āp?€€7[)6 >\†ś)c}—  qüÕsfOĒūń†j¶TµņēįB ņœ,Õü ļ’˘õ÷>[zFį¤ŪÅaz%ā#Ö$H³*ø‹¢½#*=¤š,–ĻŁŽ¤<Ģkl—€·•ļƅ¹ūŖBėté§õÕ'‡„U’fó؎d¹‡›ļ­ęzź-„”’¹7¬×éÉ/€hFµ­›Č³£5›'ō«ݹŒē%³ł÷«§łm§Łęš„LdJ‚yU7Ē\Ī{'<‚‡£Ęo³ŚŽP0Ś ‡wépŅOų¤æ°ś„¹o+ęhÉł\ŸĮÄ£‚žiŲō#„(ÅI’ uNģć\ŗ•u±•”«cIä4~Éץ¹,F»Ē’žŖ3Põ&°KÖ/:ź6M…½,Pł‚±~ŸĢDóz cžXĄgįžüī­›Š(⣚ˆ'H3÷Ęü N;Ū]@_=馸°ŠĘOĀpYŻĶ);P°Eoü]0«‡¶²‹TW]iē?T3]÷īāJA™…%iŁS–š)\qŽ©™{TœˆÓē|J1sCÖÖ׿°bĄ`< Ķ…Ļ5cguy‡@õ::ĪŽ’³E*¼0¬Pى>įC±åҵ3"_’Ż˜÷"Į²ܗ†ą*UĘ+Zź;yĪ”u@Čž×Į5ü¬†xīkźf45E”žšuĢĮpŗÖ‹Œ‡½Ø ·ń¦ņ׏A-ćÄįPV+d ĢosģJu:uķŻ|¼ĆĒr˜]¾F¼°—h —™g­*š9„Ā-č~Ebžįjh×5šsiĪÓs”Ŗ O›7/ųj#”“1:éV/ĘüDå¼f¼äż@®/–ŁœvJ"CoĘY¹a|ōzlgL÷ڵQ·u|=Kš]¹=ś<å&ē„ÕȄ¤­Ļ#ˆĻģ¶Ģ"µ˜(Ü[Õčw‡õŖUQ¬ń/NN·„ȁ+ßcĢ’Éž·øó˜įÜøį“pŠ •X-źlń;0p™£ś¶NõžlSė¼ŠÉ3ßżG•†Ufg6Ļ}sź©å{ŸČh’P°sµŅģ”$“ —Ż"j|Š* ģ/“9ųh–Œ¶ūå\8,` e‚ÓĶ’ÖU»VIąó‘•i›ą02R*́ EsŻ,aµĖĘG?kw+QMW~kK¹Z{-Ódļg¦« ¼ó†$N˜ęK}¼ %—®ā”ŻNŅn§ÉŠfįOō^ųS„ ½„*"µŽė d&7Ge ;½é.9•tõE~$4¶§[œO£Ålśœ±GšŹW²’ ­v&uœœ~CūäˆŗėƒqtŹ ?ü.“Ń;…Žtƒė"7óeČk f½$4 ŚÄŌÜ5RBKØöUöAHXĀUZü±vÆ –“"Eõ^„éå©;QÜZP¼gļB¬gä;Ņ“— wPatæA3ŻĖ›žN“Ė?y3oŠÓ3ąž0ټµ:3’v°³¾(Œ†| Š=uü6|=ép é¹"µ y?nõkSW“d ޼?R£g^p)¹GyS£$ZIVČ£īAÆ1į¶Ŗ”½Ņ°‹6ÜG‚Ń«CŠżą¤-B]•õ"ć`<©b(Ć}d †į„Ł~æ«Śq{JYSroÅ3"ž‘%0ĘńŽ?kOÄŗ±÷\vVŖ%ÜYÕ>kzŽmꏈ£[O^5ŗ½’Č]ÖŅ[Ž‚—·iéż§o½xJڬņMū±’”-磼š 0#TŹāc†GkߣVŌF>Ŗ ŠĒhb\snāžö*ņ/#ɏĮPjöIĒĘ+: É_ kQ.Qū曟Ģrs™Ų{ČBJōČj,}cʉ(\3Ļ$†Żä­Y³ó¶ā=łœ Ķge8ōŸæ×Y@ˆńÄ,FQ2³BžÅ„*Hv]ohŠA’6ų«Įń*ń7ÜŖ øĀż¦™W{~śDķ’¬0W½ä3«v胟ŗ[ ŽXęŚ |QX¶ˆQTĘ'Ż馞öTĒ Įāäxź؂,N¢Ā»pŽxfž”¼%1ŪÉk]÷āß 9’HxÓ`ØJэ·s Ł~dŰėźĀ~{õS”Üėķ²_n”‹Ø©ķĮÆhä+¢ŁŸpßźÓJ#‰¦ C’nčxkCkƒ9Ę®S bf`šx'”°ø“’nk>¶qQRĒ O¶32b}Š!vj?ŽÉ©‰iŒSgTę“eš»qłŌZ^ƒtź+…Ÿu„ż<3؝]fnŽndG£(Éß …ąq6ģ\¾SŅŗÜg1š`ŻųUS…ŖŪЇ…č{’š×8ś©^;’a`vå®’;é2͌w–r#ø¤Fξ‘-„\œ˜žČ DĒćys  ļD[lÓ*;c f/Ü˰Ąf¼½£joA„@+åӗ-|c¢0?௓ģĮ h‘$”kƒ0¹õĘąÄ]’A˜vaßW¬MQĄ”µŖĢ™ D ~3`:u’ł,ŃHdgŲ ņx»«žöN6ē…ĢŻUĒ»3pVÓģgˆ}žxŚóמ=«cmUĒž”¼…Zą/óŅÜH}č&}2ė„GŸXŒI£T¼vмŠWĄŻ÷–d2]’vĘ‹vl¦ÉĖĒźlh›‰,…¤ČNońi>$jŹC ¶ÆØHgµŌó`‘?“XJpˆņ]޶|õ#o§ž³ā»-" ’#Ø«‹ҹĻH¤üäŲYŠj^ąŲFąĮļŽ?m]F=„éÕØ1’lsN ˜ę¦|ń:fĄ#zųē š93/ŒaCSŃ4@ZĘ"s­m&³o±y€\·Fįw£»®9&ĒīZ£Ž!{Ė# ģ[ššķ’ŠĻhT¢eś7±%ć{=Åp’Ģnpó^9įæõ9į#ŗ¢Z8Ƽ'Öą—ÜÜ`ŲܘQ‚“¤XAŹ:ņ+—Åx§ŠZ!R{ %wmĄ’F@C•ĆyFyŹĮ׿o 󄄁›{_ImAͱĘ؊āē1Ø0öԜš)…ŁT/vvB_ C)Ŗy‘ĶržäõʄĮ=PЇu_KU.^„ÓpKj!_žšsrŪÆr/1Oa<ņ0IS“žOoµSaēG'"±ÕmRé œŲœ–8 o~č²b·“ŲŒŲŽ¹Šlb<ŠĢ–¬ˆ£®“ĪŠÄZH©£ĮˆŸ[ '~iž“ėĄ]̤†Õ2JŖCYŅą(ÓŃ^Ō:± "ŁG54öŌ–źxģĮ·¤äč0C¹f{ŠŖ²‘V_ļŲ(³„ā£Ņ1!y4|ŕft­ß±†qøc<ŒØ(ń¹@mPøL9½ØĢŗ6}@œ°½0Į?YńÆs0`ńo’Lņ›ūŗ³†!ĮD0²Ÿ>\·‘" ™©¶Qź¬r³Ÿī‘†‚/ÓkĢÜŻ¬ŚM¦AŽī,’Yˆ¢A_QÅPęōĻķ | oĻW©_‘2«@Åb]k*ø}ā„ČßZtšfų(bʁķā¾ÄgzorĶÉĻ,\zóŸ”x)v=]„ŹāźkŠCŪ‘R¹Fj難ńĮcVŠo‰+|¼‘]ćõü†įŽ&R2ļ7Õææ!÷Å%×o”ū§ŅŚR(ū™™ĄqpĪ ŌQ9ƒiØąk<*H*¶ŗęIä}Iō­ūjēE—ćŻręüń,7»ˆĮ¾ŃPaÕrNOÕdW¶'Ž`Ā•&ŗVIō¼}'P—§ õė/Ča€¶āö˜mŖčąć¤É='•] =hČu  鳿ÖÆe=ŅwĆżÅŻX ½õ;<Ü!Ø}1öę®™’#°tĖaāH²“ńGaŅ=ō¤lc@KūųH4’;Ö’œ.Ā”Yvƒč §›ą­ąŠõ©r^īßsµ’ī »ĆŹy Ć9b£¢&üg[‚3jY/ģdŽżģ·Ŗ¶ ¤½8“dA£—;^J%Ķ ’" ŠS¦īō*żē<)³6ßĻ|±‡Ü3;‰żš=q©×26żnÕÓO3™d˜4¢–1,]p£™&ŌW÷ālÆ-÷‚ōKøKgO­h*w6ēįå6z „JwCgź’ó>Yq»‚ 4.…×C•Kƒ)L^)ĢLYliA|c©_A.ģŹ‰ģ”Ö e aTu tHńŗµ­¤u: le#ÓäŚÆ3§`ą^vŽ=ē PY/é/Ł1Sž­ģl‚Å :Ó`ˆ¬Õ±c8¤0ŁÉ» Æ¢kl—r²žxWqŻ«Ew9%õ„¤ÕUUį(s ķ§ß,Õ³`Ņ1‡ÆsÓćµ)Cäv¾©3»f†?—Ŗnh2œ‘’R2…a™”B7‘Śs‡ĶKݵ瘬.»črĘś]Ø!is|SČū4ø9œ]œ[…Ō9[žļ…»e³€GXQFŽāL¤Ń¬¤r`:6­oĘšzÄč¤5uFL…Å 3 Gā]Ģ'~Š"INšŒL_¦¼*ä“ĶįŃÜÕŻß<<ż›īˆŌVt¼‹wēųD]b•«Iū\ÕæØ“Õ5«ŠČ¾šÖz#Tqd ¢°\:ŗśĒ›ł„$¬ƒć'^”rŠ!2|ܹ1_Żi¢”C-<šÜÉ“įž”ßPobŠšŌ v(•#2Cć±_„]yŻ}÷“nõ$[Ā‚u<īŻÉŹY摏šlĒĖm<ƒļm^.ŅOK’«>Ņh‹€ĢęØ=€‡Ä8^Œt=+C.L˜—#2ń×WśFČrińµBāäń<Ż¼jļ6z2^T«ąŁ˜Ńdg‘\'nļ5Ī<“¹ŗĪD…Żwīó"pS„ŠV‹¢ARæ2“ģĒyśļuP ¼qS“ø<ųŃY:OH¢¢šcÕu‚¢>¾U6—0rˆHĢ…‡Ģ—?#‡4¦SYõ™Óŗ©Xū¾ŸÅ.S$“‚©9“l.ń«Vē«RęEeo™¼Ģķ‡ƒ\–‚a±<:õÄ0ƒ…ź Į-Z-.ŗÆ‰4.§)öaU,OpJÖ+$ˆIFé‡[Čõ—X„-’9ļgSĶ|ĪÖ–vŪ®ļŻŁ„zŹęźžsx<ŪizŒ€oH遫g„±yŲ‚/üµ¬Ø0¬"¼ķB|sN®½čÆąµĢ.öqNģŒūźg¤ę—¾NĖh –÷Ų¾/ß=ŒČułü”„©¶F2E:ĢŖ[”°0+O0jŸ{ÕP™ā®PNņ^JęW²§źw¼§īāµó[öA5 <\ؓբ3ĖvJ‰M%ŠD·5lūOš™6Ŗ§h·gSĻTɄ@ -cŒé•ŌČéūÅóVH+_Zf(yß­`śØüĪåp­Ńž·„„/¢&ū–čīR'į$ĒĒH³YN7 ŽŪUÅī(f— ±“GE 2˟¤Ęäå č>¤’GGŪń^ą'L°g£ĪBęž^øØŗh!eĆÅI&ĶQz .L€b—}rć/ Ź!Kƒļŗg‹±o“<š3r€KåÖ`6ŲöīŪ6gQ‡‰ƒŌ>·¾ę5r-€Ņ:Öó*M3Œ” /88śµ„;mĻĘK|w­«s~¹ėšxÜPÉģ Ż0_‹¦u.6eČ²ĄÕæFœ,aÓŽ§Ģń’Äfi!G:ūqFÄŻ[­‡WŽ<ė¢"Eъސˆā$’4_ū­=ć‹4×ģōĆ’ÖrwAėµMÉNĀÆe§°+ö½˜5’7ƒē)DŚ»"D˜Je(Hjņ“ĖŪ¶uŽBښ=Z÷?eœ×M{b4oö„„ą8I‘1ōL‰jžē~ß:&U“$żž¦mń®†it8LqH.“ńĀõ…­l¦baŌŲ¼„'œ˜HĒ-Ąņrf:T3d)2*é–ĘJthz§öæklhfåóČĢ×^sDÖ޶0ź“/+¦}™`h;Z§w„Ļ*yReÓiÄ:Ī$×sö@ĘęøÜøc‹ÖŗBŗ+Ck'Ķ0ĮˆpœY•‹a=ߟ}ŸE’Ŗļ^s%A¼…W-’ÜŒŠi¦ŠŒö¢äĖčćY&!õķõĻ©Ŗ×¶Ķ KRYŅLmŗÕŌ];ןµĪS©ˆoÜF¢’Ÿµ,®oĮ)äs9D’Ń(\üˆŅ &™žĄĮ>Ø=Å.™Æœ¾@3WxcbˆtēŽ.IFž$UB˜¦­‘Næ,ą{Œ®%!•IÅ$Ö*·öuŖžwbNģ€é}ŽüĢ0śBæÄØ;%a6Dvąf…ĢŒC­4¾ā=3„±FĢotõ“@_Č:I{ęSĻ|’g éM®Šę š~ėĀ“Ł>Ę<#Š)²­2S8WE#ĖvŌLŃIż*Ͳ*ļ3xĖHq·Rś‘nž}÷Ü™³Ōā„“›œš$ ʍū,å4.õG· 7cĪ 9ųøżĢn9$›ŻyXŃźQ]ē LĪM!±Y S»ś8 (m·½ł'ż÷ DŒY8’Ź¢y%pg ¬Ą`U •]$‰l2S&‹$–l.öj¢0½‰c:čD68‹q Łó šL¶•;gŠcÄzꬋõé²Öz€+­ÜŲ0uń­p“< ·åø•`H]LG¢7d”W+Ę Į)^rÖģ*&x ‘ŗ¬š‚©-h®õ}78yń¶.ŒŠzö1÷A}äDķ!šŅ¹<|ļIĪ,D‹WńŌŽAžķŃ#’5z !2W1旇ä*œIh鑵Jsx—~ŠöXiøõ™³ŁlsHŅ90¬°Ķ‘±/15eŒ‚Öæ±ŠĆ 7½*ƒŸŪW°œŹ*#…ōWP7¾ŗÜd_˟Éɏ+œŲ÷Óz÷NĻic€ÉUø9üPdĪą—–ć ×]d"¹wśĶŅ­›ćz’@n® ˆ=5BÓŻœÉäėŚq°öĶ `ö6‡Ō9¦Į”ļČ«Šżz4iˆe/¹3IĄŲV§ĻŚ|Š–a ĀŖƒA»=Ļ®­|Ų1[Ļ½ķ§˜eś8ZŽ^Ų-ņ>a$ZųøoכVęu-A:˜—č”ķ-¼æź—EŁį2]„ēŪ’j¢ó„ U8 ŃØŌĀŠķüJå’«B+,(öĮą;ĶDz\,„ćlFl؁™:(Uāµ”ČL…tb“…Äč …4pZpGˆŅ#6?ĄōŪ“9j­–Üž †¢ ŹųÜ^³C'ōm)2u/łµ”Ēęs²eX¶æ%čUćדL1\¼/¹wÓ¼LsĪ{bßwZæ¾!ń,3k+ß^$eś^čzC `cŌÄsåC†ŹĶ{~#sÉ ³”ä ŹNĮŁz>¢,ēN*wƒUf˜•”% _×AQpU·¾~ˆš$EX1ūéÅzŠ`*E¤ŖWq’R£?Ā}ułŽ±9Š[8‘TŸŽ3ٲ š!\&*¬<ŠŁö%%Ć, 4’Œ–WUp#T©mWōŹ%\Mš„xĘł«¶ģ!·ż_M÷’Ņ¶Ŗ¾‡Ų„Ģ^ŸōŚ—Bq½ÓØĒ¾P¬Õ·3«CŁŠ”SJ»Eˆ4K ҌR¹õˆé’+ž"ßµ/ėŸ#ĪŌ&Gc~”<5ļ(McOś™“Z_p»ŹŖÜ]©Ś{”ųÓI<ŠŻ¢üź/Ö Dš V½r=-Ą7’Õßū”µ^„é'ŅĀƒ³:u÷ć'ƶ8^ięĢ–»YųĮqabq‡÷ “Q½ū74ųÕ†Ņ¼ĒAy_¶yƒŻ@Ā5#kĄ'æ kxm÷Ѳŗ§¤uėÆYō÷©y»Bs;ą\K“ōžŌCāĖ… 3Ė%y›[?ļ7øbŌj±Ā£'Z2ĶD깁Ā!Åm?^}Ōpõ…&[":xōuż<ėÓZÉŁ ?–ōA÷Ć7_' `ę@ėŃ b²5ˆ“ēiųMÉś”@üķž’„]É|É)„87ć©§¼ńŗŖÓYä§j÷ņŲŗOŹL@£ *•0S¶×[ēē*+Z,…±śYn&`óęģ°W—Źa„©×’%†į¾} ĮŽ—VU¢<·ź=\Ōļ’ÕGkół€7š>ŽlYĆ"CSD%ƒŁ:hX¼Rä€(ÉŗŅę(9y‚&0žÖŽ“˜1wŸ÷„ÄWi†Y€„\÷į<ŠOša[?‰ę¾y^$€śÄØ} œSl.ūQ:Õ„ŚG)uQ(– ŗŌĀØyˆ·“üĄ“'ńr½ņl߄ƒ`k®ƒ8„–„gŌ~@śČkĆū®ŠŁlt42.żœw·P¢Ć’·?rĪK¹ģL'yķC5®bZD+7ŸnY»‚ū6SPč>Ż&*o¼~ųN¹Qų'óčA«3WWd"Ūź¹"^…lś¤ŖķB#Z·Ō7 \Ż+­€ķ6äSqV¹Ŗć½½Ó8ŽvŚõAM°ę\„8GŸŠ‚—›Ł{t]%q9Ł>Č„³ĖŠ‹Éó“·Jķ2ŃĒÜūRņĄX2¢²ŖØ«ŁąJ…‚߀mēéVI©²NaBćbmkAŽĘą»—ęĀĘS(VW‡±Bp§: ü#l:Yʅ2-‘óģÅį{‚ś€¢’°VNRsĒ Ć ”/$psV÷µšK’{. ÆN_ŅŲČįĀ™‘@q‰‘¦ CeøĆEĘt‚$ ‚æģ*brÜ?·Ó²šŃķgć. 1¼é=#²&óC„ģg Ä伋 ‘y·÷\˜½ņś'č”ęĮœ—ŽgI²ą įłž<žķ šr€D-ĮŚPsŌ±—»4p·qÉT±HĘŁŻŗŖ{9\£€łÓ‚Ł@2¬Yųė½Īī āWLvG¬”N`®Ģ£]!«QŌ#PIõ6Ŗ<‚'šnŖ6Ų/©KnĪDłČō’E§Ķ­ĖfĒ@¢>Q½įNȋukØ,Į/9ŒČˆĘJ„¼;ÕŖrՈ4¤ŽķÖ2øÕĶ Ā¬1G²å=÷‡g6÷ÉŃ0éĄø«>ŻøXX2Ę¢+ōĀĪCˆŃx “ęŖ0:Ż,9‚(±él³ Ė”ßŲq”żÓ?°×ƒļ‚vc’K’½øa Ähä 1žšž™3ǵ9•`łN†³<Üį @`Üq]ĢÆųĮfėõ _äŌŠØžšČŖčäŸx‘ Ą<ķY"ģ®[¬A”k°ńP«}ØēgTjāi.Ä ”T  å+Ÿ†~y^.ɦ(q@ß(€TūnÖöX ¶W-­xZå}ķÄŖöŌhgÆŠ/K¦Ļ›*öļ'Œ£¬ŌC3ųŌň« ²K;¹»”āĄ2@ü¾Īų("óEH»)×Ik`%ŗjĀo}öˆS°Ć.Ł0¾Cetõˆ“Jģ@Į±†ü7ķŹßOH”Už/ņNøE†z5k=ėš{ż<ƒųJ`[tj>·¶Sö…HßZ\ŻĶ6b›ž&5F[Åš ·<É£įņmm–N’š„€v«›Ō8JŽ©Äž‘7xĄ©v0ĒüĮ{,?zĪĆY[¶)ź’H7E¾:x|J?ƒķˆ"4‹=ēč•ČšoF€;ViŠV M†¬ü?’ÉŽ«Ōč^é:°œ«±åĆ7Ėb0׉#_’nšŽŗŲćHĶ_.Ŗ%!»"{œ-%% J’•h%[tž7ėÅŲ9 ”\^…AĆŁ„ 6o +½Ud®t[7¹eؾ“ØT²Ą•E)Yį澩Ž`„ńr³‚Bƒė”cżc†±KPri˜"¼coH)rx±™Ń®TńøŹœ:ٳ•ÓŅw/ŸmŽõyE‚铯“ā3€ >éĮāąq*qTōU’Ģ\m‘ÖŪ˼ŗvX P"8¹¬P¦L ūĖ€J§ĆžYÉéäfŅQ‰Æ(Ēz0ƦB¬GµŽģćī«Ō±0š@'°Ō5„¼ßt^Ō8uG)I«XnŃT7Yߋ€Śp#Xb€Äz¹‰ĖaõéRUZŠ,ŃžP5€ 'qčD¢č‹ĶtF)śßŃéŒųG’@˜ųšŁ}ø”ū/p –"™}Q<«lL{8C ‹ŗæˆ)ŲŁ“ĮK˜æ%ĒZ`‡_ÖF?X:”µ‚£Æėˆ5” }ÓĪ–Č ń e½n7æēõÖ­&ƒPÓb;Uāj]NÓLhšĻƕI^ś^Ė3߀;¦Ś}ćĖ øÜ“Ķ~ėŹ”Yņ&Żćśą\’’6ļorMO©·6Åŗœ•©_;ƒ#f…;vҩ䲫ƒ“el‰£_§«G·Ŗ«@všoßvkauTI××,ņ²ž06d²ŽÆ—€9īcšČĘ|Ļqõä WQ–Kõ–™.Š_ēŖŲZźŗĶM7£ļVÉŅB€ĢÄ`Į…5÷š½(š2tŒ•š/Ļń_Ņt†éę@wV$$ZC€$øš®®%+tE`†üŅ^ŻŻė= Ę(ò’ɲøwbŸö,®ZW( 85` i(jķ(S¬n˜“tNlŸ'hfSŸä(~õd0ÅeYėbŌ¢ O5¼²ģØæ.Ąc'm½æåGHņšhė›x3Ż#óĄ<ÖzĪeÅč÷µā•@5YzGū°ųj}‹Ūä 9a ¶`_“€CÉ×b;šm׍ėŠ䩲uĄM]ÅUNNØŽ»œBąŠ,Õ@‘öRŌwžwĀ;p£}æŹUPŁzā° d,ŚŗG8ö“žāq!ąg„ž¼=Hš]ź`źcźü^SĀÕĻ;†£ČóĢóNr-5ŚńūŠl4¼£i^c1˜$,¢\Có<³peŚń<žÓō&ĮK9eśjąßlZ¬Aūžõ£DWåR~ßŃEÅ ŹŽ×5O į̊hyPĘ{-éĆ5d n÷L4…RÜh#n­­9lā:Č"”r\¶šķ]“,ÜQ’I£”Ą-§|{H!҆ę=GoM®–ń¾‹\ŃPøśiŲ'‰‹¾Š’sOč:n¤Ŗīż»¾ d.Ÿ'šHwD9ŠīX炾K–€L!„śŲØš ōuķ·ØūˆµS¢µ‡³KrĆu׫–ƒss(Øéęķ(ų±uOń(ž<¼¤š›¹^ŗŅ홐hōQŗ“WÕ±sŽzžqm±eß[Ū+įĘg ?˜rŲĶ@7X«”ądµB~¹Pī‡š&0/¢óøīRŻ0 ~ųA­ T3“ U%ˆ€3|5[<ķ\³5÷‹Õ9”<žÕy˜¦ŠŹ c„ž©#‡V?™¬FM#\ÉŹˆ~ j˵–uiలЦŌHķ°Ņł—żn&+ÄMį[fDŠŖP“³ Ź8|-Ųsd*9r€[>Āł[ćž'!#ž © ĻÄōE˜9éą<™H/蓟tjVxT ‡^xšpņ”¢hp|ˆ¤dØ­eųjĀT<1ó€×HśÖ£“śkLł|¬W1ß'\g©¬›½ē”WV±Ö˜ņīŠ:Ux­(|ŒŃ3°jąó]–Ņ/H#ü1d «°Ė›’^ 6xk ƒšŅo$Vż’ƒŒ¦łz¼õģō“„¤õ8T"ŸóltŻ4„‘'ęVńŠkh÷¤`ŠA<ƒuaus!»VaÅ9*łćŲ¶åt«hģߔŖ)ļS!é"{'Š#‰“ņD•xJ9ūpÆĘĖ“9ö}o3ÄF„1>9?k ó?Ł£ÕDæ–Eā÷~^łnŒē®}ŠÜćŽ¼hü¾ dÆ×’ ¹w}[ ģ(zQdćõĔMcµGŒŅŲ#õ“ĢN8Ō©›Š!'~0’öa}|lX8äcÉ̦€ĀU*]{–R`¶¬!•¼ŸJąŖżĖ$|}WFo»Ö؛^$_=Fµ_ECīj÷§’·H_ž żŲüh]ćp-f|zżiLQT5“¢ńZ(/śāßAg®*‰Öś·š*Œ±dr¤śsRf,ŚÖŹ#?a0,{ŚHNm"„ķ·ŲŃ©ä3š«²ĘBU¼M¾1 Ø­ŌüĪ' 7š6Ļe†h#€2„:¾ę, qĆ„_^‰jM<¤¶˜f+fŗŒŁļFĬ|* įJ”Wq‚^M¢%n¢Eaż@xójVŖ­kėj'QØQݰ[„#/¢āČ|¢`‡ņzR4FĒé‘^œŠĘź ą­O£zą øLļ9X£ Ž5Žŗ …|Œ”„nĖsõ{4®'ģcęøš åÆA³{ī4<Iżt'Ü3mńaÖĒBóA\8¾»n‘£mKļ wĆŻ/weĶ’ó™KoEāų Ķö`3:éW~B(-šŌFkW¹¢ēŖf™ć֐.>­R„ĻDĀw]»MŠļĪŃmµwž(Ł vJõ‚³p{åq¦µÆ!T żĮö5čÓ./ę?Jö©iŻJWõ†&æHŌö©^Fo»Ń®źī˜ÅMƒV:‘¶ĖÓ±ćĢ»'Ü+[õ™ĮjfVi”˜3GyCښ…XŸXŒGŪi‰bŻ£?hĢ:%.ˆ}AOӄ‡źõ¼=Ԑ€śóe!9¢šūŅU(āŸYjļ¶SRŽāY#LČäiśŗg9‰ģĆuԟ¶Ų f’¬ Ū3ŠÄ^÷7E6¾{2óŠ«J[“ĢpElҵ-J‰(¼„mQ³„דƒ—įŚ„˜4“żmč¤ō1/QŅßū[ 9@óŃåGŗ¾ĒyYä#?‹a‚ °µ„ jć¹ƒß$QĶk•9,s8®|‹¦`Ņ©!Ą ›Ņæķ-IŒL“Ó÷‘†čBP9ӂ”TĮšŻ]ą씤+æmōĮ@V}ķO·8w!æł¤{POŽ„‰3ąņž7 ®J!x ‡µ“‰3ū@bŃź!U#ŖĪXuīŠŌi)„b¼ė ü”jŠ>ć†Ń»3†D®×óm˜Č—Æż“ą3WĄØĀSśķĀ­ŽVƒ‘ŒįƇho»ļŪ.qš+q<[²²Ā“»isöä¾c~]šŹĪ6°mA'd•5Ī ¶uę„-JĢz~E–ż9īŻÖŸlBOt”­“S’ŗ6sdZīacėż+Ź—F÷ĶŽOÆIҽ²)kj£¤“˱Śq•ČZE3foaׅ‚CŪž'†R“BOŽĻ‘”øl,ž_£.žÕ×tpAH¦žˆēPœJē‰Ąī_$(ßČ'säī9Ļ“&vŒ¾ŗžš¦|ĢMń…“ōĻŚA’ąĒ€¾ŲOĘ&ŸĆ9zSe&įŹēXõšX™%Łƈ‰ŠWŸ¾q9`J‹ķlPHL~™£…ź^—Č÷}“¾c{ ŠķČCŁ“ŅĮy„E0x½Å\§’å)ö0k3^ «•ÆņöüŚøöKd)üYh‘} ’Q”=ÕߑołÖ¢h‰Č©ėо©ä/Ę®4“h+8%ɦ 䁺X kNl$Ÿ·ą·atŖs²ÄŽū°Ž l9 Ö{“#FWėģ”–Š ę‹KŸœ2ŗh’yB¾X'ż™ĖoyńŻHhļgÖ]ģ_zDoTČ$˜ßÆöŗ~ńµėcŽĀGädŹąid_]Ęī¶*e}n‘ėP+×fų¤¶Ä¹{õĘūūŻžHÓ/[YX§€I, õ»żbD™õŃyM¢Ś°n‚(TļČ{ń G‰kĮw¬µ®m&FĢnĮåµł[ņ"jęsKS°–Ź‚ÖyVRO=~I}Ģń>ĀSŒ Ģįhvˇ n§~= ™²ĶYŒŸĒwEągOŪ‚B_F1%æ‘Żā!åżÕkU5 mŹŹrtŌĀ—ņī‰āŽßųFK7SeGm¾×i0õ÷FēļZt¦|¤wSK„ŚMT+Ż2Ōą!ˆ$LGÕ&ŻTŪ3Å{d3¹øĶb̹FińČīżµ¶ę•“ĖÉ,+qWj­“$½M“>y„ž¼č¤IāŃ1`•p‚ ÷®q·]ēĉõ•ąŲāĄ›öœ¶1ķ:_+4n½?Ķ—ÅS ‹ į\)3„ńč†ū+‡˜²Ü2|aT¼āā±ķęĀLBźČj%xČė BD:ib “sD 0:ūdøĖ”Ł×›¹m)}ŠŃ7”%8ķkĆė1U86а»(LŖ,ßąŁ<Ē—‡¬iP`āįłu^’Ŗ¢øŲ57$·k‡øŃņ–ĄÓł|1öfŗ/÷XÉXѬÉ{ŁÆž×-*Ō–õ8Š^š„Ū馆ĶKįē„•ˆ-ń佖+–R‡¦K¹ō²²ĶĆµæ˜¤t§Ŗ„+œ¶C[ˆÄrŚFøB}]!Šś”e· (ž ®^ƆzA…ŖźȜLQzZ­Ś}×ÓU¾ÜĪÄ0’sę'n²× LTšńæo¤i‚©;²rA•š…®ž7{7|¤NĀ®J…uü²ķå[}ūĪ —†vn4©ŗUłŲžÄ=M@­(dŚ~c-O™·ŹÕĻWéV>,„dČĮāĶ^”Ą%>.ląīgü0±ŽņĻ›y²Kt6ū4 č߯ėKfi~/°ūĪį9TVG3’;¢“RY—³#ńdįĘ4É4ĘÄŖd S05q˜ĶĪž¬VõŲįQč­ķū²|p3ې$§ 3R"½` ļõ–¹Ó«Ī )»^č7iUÅØ‹æ`ƒi˹Ų~¢ĪöI~š#Š$aÖ“>F)‘%ļĆŚĀžƒ\£fŠ*i‡^Ø/±¬-ņ³!PGŖ.EG£ß ‚„ĖXĻą9@Ō!³,™pFĀ€šz²H1Ų•8ģ@#¬Ō-”ˆ R L•!oöƒ6©ĢŚĮ ^WלÜKaOYĀš¤Ój?”Vōʤa]Ü9S†£7b­;źźl|<ų€UŖ;٦ę5Õļ ĘO~½RŌ|7ĀfĻŁz]+aæ”’“de;2~–^ģźOLć½sAw|÷_­ˆī2|V7ŗĖ5/„N‚­•7½ †T聃ØīöŁhSåŖI 'gĘ m8FFhÉĢ sī0<|FS~ b…;}v*yõyG²÷PzZą}–v„‡)Ķt“š±Į –ņ; *±¶ŲJŅĮ)ļ9Z†j n©’"ŗéwŌø1Ļ„V&ć’“?DLœ_Īö5Ć`ØWŃN!zžUR©IMĆ’*žO3 ^ļ ōoĖŹN¤¼q„Ļ3VõēÕņFūńę`®7A&‰Ž ŁĪf½fŲF5ōšł•Z„¼@QŸŲÓÉLGæš° \”xfŽ2+)éBćd“Üsм’…h­vĘÉż#/…:uZv· ņÆ:ī!2䎠™^V1”4uӘQæEĢļ'ż¬nv‘}pLō(ņ„¢KēŪܬ¹”©®8¬zŚ–)ǜ©ń˜“Ä ķtu„ģ>{™ó”¾J2l\VøŁ4hKŁ68¾a®ŸNfŹ‹F@6ž ļÓ¤>¬õü¦Ÿćėä6k†Ēi“Ż_©Œf,5·f E‘c›Fč@ ¶_ŠC²Ņ°Ųß!Ī!ߞ4yFBnjī=ŹsĄ|ĀgЦü„hČNŪož”Į՚Źp«Ō⟤½‘3bƒēŽ(‹µœé¤ƒVn• ‰ ībŹŚŹü‘ś÷% 1X™5ņå›Õvhķ1w}<3«ˆ—ąś¬G `n°dö°< KœD&Wń‘1쫦æcČT>ā;Ž8Ž2ĘE#øR½ IłiøøO6]ėŗ>v›m&”j0Mßź½$ił¹ųēčdl,ü”’c| Æø|Ų ų,B¬žź|{^11€µZ˜|"! Վn2«6±ßßĶåīp +0€6bѤŪŌ ")mć¾Æ×Ś:@½¤cŠ\O“‚ó¤Y`·Į•>Ą;»MhłµrŽ÷oĒŅ“ŒßUÜ­‰Žj=ąL?'µdRųšĄū «gų~Ž®łł =€kšį“!Ż0-łé«ˆ£Y?õā>~W1g”&'“śˆ9ŗ£dś?R¦ĘxßE¢ČÅ«\ŸsĀ¢å|P¤”ćr;(Տw„iü,t¢?_"Įb]*»v’cģÕe±oķ*iV&Äæ¦WÄ®ŲĀX§ĶES²©•ł‹Óał"µAT¶$_°’īFßWxĪT¦ŸÆ!ć0ģ¤Bääų&ā†Ļų˜)NĶWw¼K„’šžüīM$ĢlŽÉuć‘Īl&ęż„mč4Ožūń\§_Tm€²7ŗ`§Ī  ĮN)쇼ŗśŸŹ©RڟaŻļż t4³ł£mŠŠ¶~»%3_[\ H¶ūmܰJhqF£å%)£Ž©>-~s3šÜa Ā;ūS\Qļņ«‚yńÜ=LJŽ—’²|*Ą|œˆśŁ7Ź©Ā÷×ęĀc…4/æ….³ß•Iä˜ä‹UqXØ×4s £8}*‹„Ą¹¦ŪūٽĢV’.HoBļffEaŒŁˆW$_j²õIšKķ ѹµo¹QBŁž)p­wdļb\6Z”—"A8ńńņvį]¾YÓŁ‹^+_Ÿž³#-śeŗčśÕ·‰Cw眣†ŁīcK€”F‘3fAńŲČgӟ«bžėņäšĶÖĢ^ŸfśČjõ`ŠčlĀJSĢE¦ŁÆ;āŻ  ÷Œ$xõ1¬ń%ņĻ4Ūņŗ[gŽ"ą{Ó¼Ē>ž=l"uwÄVsī‡PBµ©rBp)h||u:‚JÜaŲm»¦¾’[£ķ«ÓEųÉł@„s(•Fyr'x?Ī|=*y8åGUkׄƒ#\Ś{é=1£ųhÄŃ,5·w@ ]=Q`s<eś£„FēŁˆ,?ś CG Äi§·ģ“8«ō“2 ­{“‰¦,ŃEXCą•öL֊„U“ū;Ķ]ė±żJšjŽĮÆNG 0‘ļÕ%PE@!óQųUĮ•Ć~Ž“%NóŒĒłœ=óO7įV?Śx §{±¦V~hєųĮŬ÷—Ń“_58 ݲ/$–†›āķŹ¤3§dH3 ‚mēEt`’„?|„!ŠUؗ…øg—źāĖ-Ķ·_l0‹Z©„ŪĪE{5„ŅyN§Ŗ."ž® ēG­4oÜ? 7!¦I@~ä41¦jUĻ»’‘ˆQ¤I²2†XŻ8š,ČŖŌz°Wo{‚i R”żžOĶ«§¾Ļ`4Bežżā« +~ŸŽĶˆČØ(Üa^ f]" 4fŻ»šĘ8£°ZbÖvķw¢)‚–Šń8€²ŚłOæ1÷€P–fyžbŸ% l>ŹŅ8b¼„j':•ż,Y蜵L?ĄÄ ×īĢH!*NļŸQ÷/½Ūn—ńl’£“£pčå~nŠO¹æ»©u:Ž¢#Ī&@xĪŪU€„é]­“ż‘FoA™tG#G˜Ę;竣 Üy¼Ē”ēZ.(}Pź;ˆhœŌŃmĮ˜c&ć"S/})!’˜Ķi–+ÄįGćPR¢de“¬±‘ęõćŅq“–`ĖĆxh¦‡Ō>¤±Tc.Ø¦Ė·HŅ»DŚ“Į†]ī•×!˜_,idŌp¦Ļ½žHP›0,óI ‹ȃf Bņ gĀÖ@jLsĮķ-ŗy.;s2Š…×*HµĻ¤łH”y@ÜŬ<9ź½üYŖ$‚µ2-I«ÖŒLUSBœŒ8 5ćŠĆšø0*$ür5x“²ł*Äq¬G¤_JzĻ‹tuQ;׏¼ƒ€A¶ó‹VÕ:H”›„aˆĆڇØęŖąRh[ś\FżrÕó-[Ćn+ąŲ•؏ּÅX«/‹=™Č"µ?]Õ£åZ ’~€<Ÿ™7],6ČŻLLhZQ`lP,'Ģ9Öą%qQ¼Ó£\ļ^uėiJūøä&ÅŹ–¾D;ār“;[zČŁÜ9{Ü 5ą0Ż "L;‡@K©ĘܒYQAC§ÓzŃüUWŃŪ?ĶH\ {_Ån`2iE£*ÄdxvŠāķ`ѓ2¼Ł²ģŻ½kG܆¬ęY¾kŒTāÜŽcW?Hä,8[y£6;śIZ“£i |8É=}ý¬-Łß*T lō:3n‡šżåńĪ0MŁu†ßēŲ)–ÅWHJ°‹iZB?āŖ"n{ĄōvDĶŽdÄŪ†¾z>Ø’Ŗ]b įažqēIĄÓņöe2ØI lB’b5Ųä?\½}Ā×m± ėż[Æ^7öt\¤Fg%5ór“Mg‰±lļGø Ń䭋›‹‘¦U3'Ń?ˆhn¦ä7fĻy+KŻ.[•Xę]fžŸļ^I// •Ć_I·røP%ÜvŸ@Sǟ9°eSyń)/“9Ō?'y?ZCõź*žĘĘOķP\‹ކjŠ NĘSX9Å1&[ŸdÓSŲcw˜’›ō1yƒŽÆÕM»Q÷·ZK®ĄiŅēÖOŹ^ «u”XۜĆ“ ;ģö3Ģ‹ÆīHL !VOYtr­l¶+‘ūŻ|Š·v苰 Äįšä_eż¬¬Łƒ^ž£„xw?/ 5¦-°ÉĄ{l©ˆŽž_Ļץ»Ą·+ź<§ƒŹšAq—g&²`?ūN½)H¢š *„„ڶØpHÆgF@cļt\ ”…ns$Y¾°wšąØŪjJ¾ČLB$õxøū3āN/¹ž™ŗĘұ)4CŌ Ō„;¹‘Ī>TļŻaųŸ pÜ<#o0ė3{#Ż÷ĆÕgūŽ; ž$­1>y]~@¤5ĘķCī>K¹ögu‰°Ā̇cĘ”ņʖr¬eč*ŸÅāĄi\śjĪYż±įKķyąŅB˵5Z įĒ|PˆF E—ņžvöńNW±P,Ę©“FL06bŹu·¶ręų…ńU*?Æ/ž›kŗ‚R侎‡Y‹Ō‘\ÖŁfO®yš“ŚŒ4›ā.„«ä¼ęÜÜM£„»7\¤q^y3S‚ŁĶąÄwÖž$‘EÄJ3ķ"WüŠ·ĶŒtyC½T NÅL,łėĪīuęÓ«–q”SDŠ#ćɏń„`„ܜŒEʉjا¬ž‘ģ.|0K’ŚRd^$RFŌ£„žŸė.#nz6č ZĘėąxФ‰"Łc+¤y!œ–޲K2敮 ķ˜éńKI­óOئtšÕłƒŒr—eÓ?’č;t"ļ ’XSīj§«Då³Vvr„ā‰†£@g%Ź|­0_>ć=¾³LŌ„Š“ę!Lņ{ ×/~Æu~V|‚tk©Ć\§ņ/¢%?åū(žųU z‚öѐ•ŽtS»4”#|Åā_c9O•'(łeJ j‹J^&¢³+rēAØ_õ”+Z`£Z%ļÆļNē)§›5VÜ&: @Č45doN+5Ÿv¢CóAd\CąRŚdĢ—LŲčÜŖglÓLHź% `Ś8ŏ1÷×C” @„ß}ų„*}‡rąéR o wīĘK=¶)źūĄy–±÷J7”¼Ā ·!Lųœø†õ{BęhĒŲ-7&Ę-Ń”¦ėi²ÄĒBx€–9_v¼PUBĢTĘ=T†/2Č)oķt,Ąd,šCćœ8ö˜į48lk~AśQ.St¦Hf“Æž0fńrĮ„“ņ€\ŗłK¬JBԃD“`éyæ,ŒuCD™yOź£Å4ž-c?ą;}>Ģó|(ÓćKA@Ū©!Īõ%{4f¬ö;„5Y³µnł8‘ęö¹D!Fiī“{7µĆfӈäņœ’E@žüF•¼ńuķ]›¤yƒżWoŪ›Ė^Åub!vT9¼Ž-‘ŹaĢ·l|86ō›~šµBŠ9£zvŸ¹Ī©9Ō̐eÓ2ŃT2 ™sĄ„Įa½KYZżŠœļ¼£“Č#øU_ö˜jµņu¦FM« zČ$ļ5cœģ<» łČÉßu«nśƒā × W<ŒĘhq}Dv_™Ńwkƒ=ć¼mē ałœKkؘ»ŠęøRZҧµłąWck÷ōÅF kģŚ”‹Ų)e…I¹ KKńJš¬`e­†ŚµpųĀ•ó õūž1ÅSYŁÓ<‘Åõ=Ā«:óæRÜöO/-IŪŚE"ē‹ōŖĪ™pŅ€géĮ‡R V@”•B ČøšŪ¾ž³;Ä|ÓŸ6Äź ÕĶ# žrYTüŲMT+cĒ*‡fĪ`°Ū ČcĻŽæųüI+rłŅs[›ĄēRĖÜD«•·ę‰­v°_ł`‡ūÆ  ²é ž š» 0ø± š#Kļł äōcՐękt|śQ[8Ö¹»n(ó"ÖEęˆQńŗ”“®DĻōhĖŚåÉżæ…Š\`EĀoŚOC\ōĻ7–MFĪ5öŽuÓGb ŌÜ¢%ŹÖ+ šD_‰7L† yŽūW“  ³ ä%I•ĪÅ:Óø‰Žoź‚Ū“Dݽ~)(‰8NŠ÷ …³“² +:į½pa䓈³h@“ƒü•7č6 ¶›quĪ@ANdhÖ5ž¼˜½ęh%ŌdNų8Öļå÷ó4„E¹¬ūKQ2ü;³V*p$ŸI ¹ęž7µ'†éųsLé~~’įϘ8ØO¤Ō¶’¢Æ[„~ψžź¶EŅO&ē įG‡R®’®g:B{‹¦VŽÉõŻT®×­¶47€’k‘cڳN«Ÿž¹! ķ¬`ēä[žÓàۊš qPajŖEŃ”!¶n€ÆØžlt'h•Fd8<…cŠŃösŌmģŻź„Œ€ZL.>ųQl•O0>©Ÿķ ŚeTdJµ!NU+ÉĀŌk€Šž!Bō€×®fÉva.z<ž1ģ½—’JĆƈX±‚AŃd1ĒåĖoøš^G±9²ˆF%¬d°ė—ńRįų–:ąI]Ŗq¤¤ł×Nf(ē½K˜ļ.Ö®‘7Ó,ćę.%zļüh÷½P%KFv6CõŠ*ŪÜE…ēq(»Ę(Ņ>R`Įōģ“ śį #ūń/bƾf’ Z>ÆYįnƖ4ąD£ö“•©E9ĢLPV·h’~^fuӟ!ēœ$‹–māé”Œ8vŸT„œõ5WŚŌ[S„ Ōß;c&“!Ę9KóӗU±Į«‚č½$*Fֆå!øŹć¹„j÷vxXˆ§A‚äüŁu3ī%1üŲÉWb”ĢGĘYåeNA,ĖųäŽē`4hŃ÷}ŒŠ°7Łž% É)¢zŏČŠĘ½umaC€–;EœāPČuj<:ßgJ¶ąń‘ £¾9`ś%© Ē8^»“ķ+8žŒ“ó÷Ŗqō·ō›­CH½“kwYLż%¹!i9<ŖæB”ųƒcó³QĀ!̆^Ż>öļ‚AAßszamĮNēŹ1sū-š›`ļĖ ·k_qōčYN|M±]ĆzhQB>H†Ö¶EĻńÅŌ?&i„:ĪÜąD',4ōTĖ“ŹÉ–* VčŠj‹'Żu«:õEÓ{LeO°Æ7¤®_Ųø”Xł($ Š!s%·Z°J9™oūźRžAŅīˆ+F‹PĢ~tµķŹ*QÓQž(v¼»āX[“tž8V•iĀ.»*Äē/ҹē Ć{僚aĶ=]#äy„Z$™0½½§Óqž?EĒ “ÓģŸĪĖAČĪō;ō?“żŻ‚ćꁧ[~Dg¬eؑ±—;Üś8Φ×.5µćc1VŖī…©:Œr§P’ؐgB±Łzą’xČ,!\ō#(ķįȵµ‡ŠßdČ%R6 (¢Żéī„é¾Ģ[ 6ĄāoNĄčžœmøuįA֌ņ6dT,hč¹  |s(SP„¬`}g£ęåhچeI¦ T‹CNuę[£€1$Üapx\ųŠ}aiĘ=ōmÕ“Ł ‘Ž‹(“¢ŖrśŲų2ņēOgĒZŖc|šćņŠl隱’1÷@«XtöÉ<ø¹šŪåüI+G·SS_ !ƒŚž€Ź-&“dņ³†öAŒŁu÷]i1 1i>0-½%ƂODÅ'ĖŲEė Q8 41W™#eĮ•Õć×v2źƒ`N6¾ši4¤æżČPžnϤØÅN7E‘wó£g‹e¶ÖvŠęĘā…)®ĀÓxžcى‡pI¼Ækŗł3PkFõ;"jĮšœa¢t‘~īqhŸä¼ļG­tˆUõ£>Ģd.˜N¹2o„t„y["£#Č+4°“Ķu ŗ!$¤¦Eóbžk¾E[Ō$-ŗk"G%ķtŅ“Aü3D©4&Ģ_¬]Ž£^ånŗ“‘«ß»É;ßex‰~7å¤!Ŗ‚Š0±Å‹* PĶkBś~āv› G©ŌČsŠļ19śę‡+|$Y¾ ².$麐{äB.Ļf~¬§|żlX•üæ„£Ķ€ö`µkó©‡å­ŁŃoYižŒ©¢¾jGBĒQģŃZ ÖM/@tVŽ͒ž“Ķ(n hš„ņŹ×į†%óó`«Ą•¼£< ŽŪZFV>x/T®ĆѤL‰M{ź0ōl]bØYč>ӅüżÓ“W]=9—ū”©ˆŠ’]^†oP¾BåT?*k~ŠV%²/žĮĆč¾Š ˜E˜%fĖõ©ģźĻ]ŚsP;)®įz¢ 1Źų‰čßūŗ/ÕozL†[éTčņBQ/:b>Y”HKØØa€#_=ŗˆļ=śéjQŖ÷ŹkG•OÕģąÖwE:³÷Uh‹æL„ 12‚d>:ģr‘£¼¢;ęj`Dõ‹ŠµØ€=®H¶ĖaU%įo˜’#hņß½"š:.|ćī!ĶW߯tžŽ£Y×1`oÖŖDŪ›ž±š}½V­ÄZ¹ŁMą.™55³QGšé÷B{³ōÖP°ĮVŽ£•Y='ę$ܒ«—ĄöÄ|“bčR²Tcŗł©>˜”}Ä^0ŁmĘ–\§ˆ Z ŹIöļ-.÷0Ķ PuģłCūH ;’#2»”0-²+ŒÕéĖŽ”Į5‰ĆŹĆŅMքĢ0łRH ‹źn³_חxXŪ-oˆķf‡¼*J}Ć<ńhæx¤ņ’Ė.ŻŻ ĢėYåŹK@eŸÄØYąŪ,ĄQ—7©™ę(W3 =kwŠ%Äjc2§ķƒ•”ŗlī˜n›ŚWiFÓ€“˜r”(/G¢–ŅÓpēĻ©#`ĀĒćLQlŹ·‡ <Üe{D*ŪĪTļB0{+Žo8ĶEzRaŃļÕ°µŽ¶fP³Ā·’¢@ÆŹ{Ź®ō'0~ČĮóŅ[ d£Š\ŁĒŲ"nU4Pė?ŅåĶBš1i»²BØŹf”-5¹į}Ń“tŌÆœgę‰/“l†Ē8œĶēhŽ&¬ŹŗšŽuĮ6ƒZo5„³–óš ĻŃX NļTĮE=ło&ģ’ńHÖXÆo—Žd ½»=‚©÷s™Gaā«t‚Ģ"‡$‚»ŃķYįŻF™šY0s—Ā}!åZH"8”ĮT?`K'oØ “a®zÕ ĘČų¤$øŗ°¹ōąØvQ}ua…ĖŠ~„VŲvxݤ „#2'KĮĒK‹i¬Įõøž(ŸŸ>郎e’ •'°õm‚S»Ä“Āų4ĢžČŽPģWn{ĆJz–óS—…`‘‰¼|«÷:…|ŖCtJĘOeČČ®G칓蠭I!Jõ^“‡źĢņč–e‚ōÅ  „ƙxåŽö¤9¼„”X€ˆe† <Ļź“ćVĄ‡@PZś°‹]’yįŠ­œ*8· 3L(«į6ö•½ÓĀ1‰G”N§v(³Da%4#<6fHč­ąŸ÷^/ēMūzÕ\'™Ž&a¬OߓbE9i/lc-Kø‚Ąų"Ū|ÆŖ°µŃČ ę…}ö—Æ­8ß)|.es—:AŹĶ«N§Q‡ZµjN1$Ėk4¤møĀÓr'÷ģ5”ģi+›8č’PŽ’Žī+]kø>Ģpc›*ģ³ŁG! jö~§æ€½¬ąŖ5’øołŪFo,t¢eõęē|üE’SłÄĢd›?SĄKø³°]³č ®~9‰n=CŌź6™PŠ0÷¬yž¹«<w(M•a/ż‹‰Ķ3ĖM*{ŠÖĪ 6å|øʌ‚$ⶁ¼EpO™g@Vų)‘dwÉ%7”Œ'Įž>؃Ø!^*O?īcńį–b‰fĪUląNæ!vī+ĶÕIĘē>ė%aIł½”HI’ŹwŅ%?¼?›‹ OL:3¢nÜk­ÉĖxfŃĮ)łk6čÓ½v×J†G®h›9åŹĀڹÄ'Z~N¬|OZ¶±įptšĆ”–¶ųe7É]šduļ@øæÓČ3ƒVn‰;@G-i×Ņ”ą5ÖlT“sƒ‰Ż½ęŚ»Ó!ģøų®cƹų±Ü”ufXPfV“Hš™Żv Æ`Õi„ēĪé壢sŹ IlļūƳ ¾Ke_LĄ]“¬®8ŒĄ:;YøÖ2Kž>®Ē_ŽŅ‘t"‚<•†9†™š…oZߝ'*øˆÆĒūŒ¤“AĶ«tėŹMčĪM“ Ńłłš1Q$ĒŅ»ĢģÓŠ)Ć3Ļž—ß?e`bžŽjŅe›ęÕąhõ>}½v§MfāÜ¢æ¾ ź—Œ£€ŚŃ¬%`Lé .Ė•°gŸ\&ƒ­Ov6æ z/;ŖÖ.ŗkH*MŌJ@£źÄÅ2m±% z…zI…łuCD3źż³ß EńŚAdtŽ6…ĘMZ#²ę7|,2,tżśĻcUĢļP÷Æ9Vā£ī—£EČa7ŽÉ(³© hAŲ-źHŠ%"k³ŭe5<²@¢µčÅš³ķģ•}œG,ęģųĮzęÅV~œ•œZŽ®`v†˜ˆĆīǽO&~ļN.. 2žźˆ«0&½j›ŠŻAe#ĻOL:’ Ö<0f߯µ™÷ mcŹĢQ”‘’“åń—Æ²gqEčżŗŠ āʛ.ąŅ!ä™o…•ŹQ‘ł)žÕ9÷įgĆ&Mźøź2vŠ)㯻­µ³uźūgNo©ĶM“äæ­=PŠ9ē}[³`"”÷S“"žalņŻō‡ī c„Ūļ²Ž%IźŪ­ˆ½$ķ3ቔØ7_}UZ®6?EśĪNŻŻl^’éŠs?¹˜›ĆZæ½dј†/ƒĻ‘ćHv}eŚGń•g&»Ća4©J_&’–ŻvHcš?,Ś#žŹöĶjp¢0…CĢ'ęĖ£Ļb}ä Ϧ!ŗ•Q×A‰Č ÄcœźŌcŚ‹<>¤!kUC÷ך!fEJ3Ų{,v)źr‘Ÿ0JY4Š&¬×ŅĢ‹_R˜»d Ćióøęhū± 摆(įZĘ:žŁą/Wś&7Į+Ę?Ó'ņ‡?#m{ŒKœ‡ŽČ3yōī¾ D\µ± hŌ%GÕi{)O}S*»ž“±²āŠP,”‘źÓs0 !øÅwazaf”“š~¬µI”Ōˆ9#»ė(*·žqngYBÆLj®ˆ§ÓŃ=čoš›ŅžVD¶ģSćuĻųśĶ{ģi?5Ū‰˜VœOE‚Åӂ0Õ 2‡Ī:/ųöDf¦kAØ®×Čg8ŌNv¬;·æW¬"{p•gˆP°„tŠĀ%~Ų¦4nb;‰ÉŁē‡ Q_ŹĒ»‚1cķĀ ØÅOݐFE;˜NŌżWž£‡h1ŠD“Ħ`Bq¢.ŽNĒ­ a9· œ..h–w$ŲˆŸ*#f2)dr.T xk*Sļ²ŃJ IRĀū× šńshµ uKlÉ-ø«mł^I& ų&Ō.ÅV‘“Ēü˜żr¾Ć€āI˜Su-°äŌm€V>ž® nÖM¹ćnĒ҆łJ±°®|jŸ$:¤mźx¼”'‚IŻi”üE³oģ-ÜŻPü&v¤—Ä(/‘øuŃWćŲGR±#ĮjMõöŽ…Rü@ų•öžs­tˆ^ňLŅøƒh†ˆ½“·ķ·£žhńc;PĶ n6DŠ€]™ĆŌąåNš s‹žčųļŹCHYøkm„ō.Āy4å½-‰0°acĢ”NÄr]!ńÜ/>pĄ›-Čä4)›DAÕxC€å:Sšŗ¢”Ž §‹sXø‹†Ng*ž©9+y ҳ j@”ĪE³ō„ksaMćn¹„ĒŪ.]OŃI_I!]”8EóüŅš9†kūŲĄaˆ@$ńüŪwų5m.¶Ÿs§aW ĮĄMŠJY²¹žįĪĀÜōt…ū™ū½ųш’!ė»1y™;96ĖĻ‘Łd7-Ś Œ{nkŽ”säćś(X×äÜPlÖ*ņŠŃN]"żÄA‹xģ˜× Øć”@Ü!ćyꍕWa6Ę@‰Ōw°dAšŽ£>½&.ų߯ԚŸb˜k„X¶uö½Øč‡¹ÅõmÆÖŽśĘeĮ_Ö5±!żž˜– æÆyū5>ķæ$,˜ˆ½öūD\jŗ¾8ä œņß.|Ą; ZWóÓ2T%ŃF©T©ż½O,„µŌ±)2ÓkČ2"nŖҰ±bcÕł Ļ”Æä?^ń¹L "õ¤ŪS#ÆuÄ[õ8č[ļ“=ŖĘéŒ2Œ29Ļ·³ĄśhTigÅF4FqNĢå±reÜöŅ=š”YŻć“ŽÕ;šNÓLšWنŒu‚9ŸŁYŸ;x¶-Š/t³“˜ é’ƵžŠÅˈ-—’;źķGp“šéöŽÕ„·Ō±ĻŃå¼}žŌ%³q׏T{iUŁģ—v•S::BlŽs?ŁÅģlIÜ$¤/”YSž½q Ōū²Ńż§MŖ3‰’Weõ xIģ‚1½~m°Ģ”sϜ ‹Eīä œ Éߣ‰’6Ģ“—ų_\ī4 ÷\GŗĀ0n7æD°ÓsH"×{ˆB‡Š£š~įÓHŌ/ćOŅ]é6j§,œ;ø0Æ5ā£Ū«5Ī)ž#}Õž{Xµ?'碾£ĀÓD7’& Ip—-µˆ=[d{=w#_Hōū¹Ī =XĘ(¹—–gf÷Ķ„ŪŻKēRš`Óófü”bżeõ*G÷€˜ hD’®F÷Ō+\‹Ļ¤ÄÕ%Z ©(¼ēĢPŃĪtBōņ‡(pY’PŽų»ōńml’ęgšģl& Ōkūƒ×ĘŚė|ķĮفR j®|zS°å:£SFw0ęłŖ}ųņ¶8ńģN”žōäeŽĘ^iØńūžhyҰŽōÓUX–’h‚ä“ŅāŠƜšĖžōPXŃēvF›Ic79ė¼¶G”?Ī—lŗĖÖ:„AÓÆG‡½ü‡Žƒ°C$)#EčFÄčP¤ą,›ķĮßJ¢dwśmAH’6ŅŹQų5“o$˜V-LT]ö”§?/仪†ń=qÕę³ŹeŽ0iĄŗ@M‰&śC֞BkdŁĢµ*śēÜ5¹SӊŖy„f¢©ŅćŃ”>ĖÆÉVŲ™Į·åc«NĒ5üQʶ+…Ѭ1ŸÜ€‡qLķ·,б+UˆļŠ Ÿæ›#‰™ö`…³ć»Ļ -迬6‚wKls©ģPK~WĶĮH„¹!ģ?=y›³{L£A_č‡ĀĶ”M†čŪŲĢĀMlBĶŹ_³÷ļpLål(’ūt§ŒQĀ_KŻæˆuÆ$³Ļēeė6šv÷ąćLŌ’ƒ©nV7±ŻßtMŲ–”ź®0j|ĀQĘš˜č¶ €!£Ą mט¦§1I1iŽäUū²õzG8°`“•ąųŅFéóŗöÄ]b €®Uwč-T’üėQ ļKˆąŒ%p'‰B1-o6æēL“ ƒėŗDrŃP#a֕-‚,0H»¼\V&-½’L;ūsĖ„eE6QRI`^Q„».r- ćķń³üČGuÉ|Ė Å ĄuÓz,o¤5qcå™čā]\   T•·ģģ‘g7.Į”‡øCą"”挾„čJŽ0Į–Ł†ĶśŽRŖ/#½X œ Īvč)ä<|Złłƒƒ?ÖX”­D+ĢńyżĢ!׊_~ø(nÕ¹,į­j§a]ł­OPqGGL×=īģf©‘Cņ/ :/Æ*Fšńɖ/¢}ņŖ —Öü4“{³ÕS«$# „yÜN˜;Že ·­„EĄQ’–8¾e'½ÉMäŚī¼÷Ōbq¼Ü–F&,ē nµh¬$QŅ“ōoF3a_5n]Ū–ŪģmI*RćXoćuaņĶi5`c{a•Ž "wt²Ē-ŗĘ:'=æš7FӕŚ>Ū4}!’~ūIgx)ū‡)Ü\ĮŻÅÉW-ŗ¢ķ/ÉTĢ÷Ē„4'Ųj•<«hWģ-Ą’ø“Ü„ĜżŽclw ^ÖuūŁA„0ĀÉr £ŌRłš_ŠĪ›zGĢ`%?AR¢‘ė‡œHŒ…Šd’BŽ;G‹›eĘO›¶/Ė˜8«¶¶U ZÄT|ÖyÓE°ņ8³nŹÕŗń’“:½ó--Ē (”(‰h„ü’E.ĮĮDķxwÖpć½üW÷O:ć-0._Zk¤ŌŃöŠY!į ½xXlwUOŸ7=²Łr¢+cqŸÕĘĆB¼Č0ÄUęČ«"¹ģKłÉS­š^;Ī{ĀįXuŻN™#ĒųZü”ŖŠķ0Z ćō[ŸM‰žļZ5)]GČÄP¹PĀPŠJ}ˆA~{bšĀ7I$$-ÜŁ0wƒåO¢e÷ŌŠ”ݜ»ń§i¹¼Ūń—]ŻlŸĀf®Ęź`† »»HӀ¢ ōŹūw¤„g{¢“lŁ’sxcH‰ŅgŌÖV!Äß=n Œz’#Y:JfŸĄ>ł§ ŗŪX~łŚĢ󶤓÷g푾ņе¶¼’µ]zA MÜØMétJhV# ī ŠõīΤ~aŻŲ­Ō€#J°Ó:”«“ź[œałŲĮAnFų™¼&ź žR3ž„<ܾźók\3QE·’%ˆ+Ó°æ['£ļžöc#fu¶FøČå #ć·§KŚŲƖ—šł:yŽŪHńƒ"0°”NšI²¶A÷m˜ĻæN4“ Ł­’śÕŅŌ‚ĄÕ½EZ=NŹ-Ź öŗRy!żąŻ‘K?čf&IŖT š•Š™“™æOß “÷Ó¦ Oo>jćd1‰BHs8ń‘÷Or­T’®:ĀÅ·@T°¶`æn%nRS`:†#©ŖTkBäG9*«ĻV”^÷€sˆ>©ė3°«Åškęf7šL„~ŌĖ7“ēÅ“<ˆ]ą—c0WpŠęĄ×T±Ÿghx’—¹žž™e‘µßT¶ļ ¦pƒąG7}tn“ÉęŅ’wœļtÖNxKÉ©r8ƒiœ~čķR¬ĘŹqœW®Ģšœ1_ž­vuņ čNā„ć\ŸC¼f~&ćŗZ5:°4į½Ź”~ń˜ v Fä*ŗ’BeźčŚ^%b:a %@ĮRųū¦®Ę‚ęyAćv÷Ķ>3Õ³’“sāĖŠ«> ՚r{€aÆy›ōO ‚Ī.+č@x * ūnĮŪĆ[Ęż¬+xްæĀØæ2µ½[6՘dVT gÖ0ó2œ“É\ĀĖRŠqIyˆ22lÖ!”S`ƒG–EC$]qĮ *QŸ°"0ø»õŃ5KŲ¾ ā“ÄćmčķŃt F¬K„QÖÓ+:¾ą§2ŽqŸ^4ĒF®ęŗŚō~ł†4#C¼©Óß Ńņ'ęg§“ń?ź^ņŚ$ä$Aü¾®c:—W·§Ø~7븯е|ĄĪĘVąßs‚'™)źńłĄ›Ź“f~Ü[Ģ—‘”„Oį_é\;ę żY“ä9åuøŠRŚŅņ)Ń(=%/”+‘@ŖhJµĒĒA¾ū¢ļąÓbҤqĒ#ake ąNLż3yŽ’*%®”ā&­_ݾ¹ęÕ#_’žJ€-—$ę.„ōféū.i(A-,²!t9“>{ųi.øõJżoY†ĘMś Œ^ÄsŹ R\CŗÉīp׌ŖDI,‘ ŗĮ*ļŲ{n@Rq6›]ļO]g‘Cx\µ„'„¶sŌÜH’ ±’ZŌZ‰]ń$Ač9Ńö/SŻ’# öŻ©es‡ĻÉLŪ·]3ŪIĪK˜5'v°ń®wæII˜·5NQēMoŖ†*ėQ?ō‚Ź£MÖkØ XXĀ„“Õ]ĄŃ“¾X~ŌYŚ÷žĒG“žöh"ƒ\;dtņ SIį“]7óī½e"ćÆE;śE ä'TĄ—4ß+]ž1Eˆ-ņnˆŖ°”å¢į@§š»VsŽØ>ĄģžlM†ĘlBįżŅyń˜‡æ„x³“X›Qų’™Żči€–ßM’ßø\Œ%ÕóįXF $¦ä$²'QmĒĘYm`ŽÕīÅMfόó¬ųIĘĄ2$Œ9›?_2ķŽj›‡%PķėÅ ĮŠ?ĆÆUėlxōKõ!e¼y"& Ó_!Žü‘ā^ŌĄ~ąTzįß7·/\b’h Ž¼7tūŌ¶ˆD{h9¤…šÓ_El"Ķ|䔊żYūa<Äa'Óė „z.Ķ'šå«˜‡,P&\Uīü8Ø~±Ū&‹A©Ŗ™]TVŽśĢŠ8ł3ĻI¶Õiócjbsė&ÄŌ?2į©ģąģŸŁ˜zK„(š³Öģ(žAō[‹·RÉ2Œ„ę7dĖ†ci°³;čgĻFŻd čä 4Ū?¢»ŖĘ£+åŚI?ē±y„ÄųŹŁÖĎö5=Ā!·gUHPM w5_QƤ–‰?ł@Xg¦?/†ŒüW’^=Īį:|ŖöIO©³M;¹Ń3XÕ;O~Īh•öŒrŌ““³9äf!ŽM½9:Ų :ƒ°Q˜ś,°Äƒ¬ōÕՎ·„Ń«¾žœ‡Ōryl­Ņv€µAm{YŖ.õw„åŖ‰żoŅ„ĶiI:Ee܀±‹§ŁŃ(õnįß®Ÿī•ņĮA?ļJ ĆdŽżN3‰@\žŃĢżIy IA}Pdō0==iRö"Æ]u…żf@ØÕ˜żęĻDéC‰§āךҦõ9,wöŁ*²LÉą[­LÆŚ7ŪhyÉėģŠdųōøz0ē Ź“ė¦†ÆšSh«ü 71ŹNO‡©ņl”ͤn; D\„€Ū×ū/ć 9śÉ[a³TŁčkŽ0NóJ„GšÜT°øö˜ķ/\ąĒ¤Q”GģLąć2z%©¹U«£±¾3ź÷¬NĮć–O–Uh'·ģ7t6åßÉøC2ƒĒ½ŲC“j3ĮpĒEbĶFxšC‡%hĄŹg¾zŹŹ‡I@AT„wäÕAŠ' V76.ƒŒu¦t¤¹0²J\CuĢcģż¾ėlåŌ¾#W\šŪ ¢³¦”µJ@”Eėæ1ėĒ%xB7,ØV\J¼Šx'żgŠz±ß¦A½xĄĘŁM?ģ¹{g@±ŠjQ u’%~»({Ģ€Y*Xu„¢©¢“12vF”L+8«-wėļż…ėÓßµVĢ™;²@Žķ³ū7ļ ķ·õŽūkØ»äŚRŽu‚$ńŅsžz øXÅå(éhńƒ8½Nmųu/ŁńŪžŸ'žJ›ÉšÜĘłö]'ØÅĮĆĒužł0§½éaŪŅ™jRE1„°hM{Fö¶Ķōš:IJu!tްēŌž°ē|—aŲO6Ļ’Å«#I½&næ ÉF–{$"ӗzä¬0@ó-±«{üĒgumØ0…pŽ@ŚŠė9zź‚zn£ˆ1 Õ nµZ̬ ³'C–>CŠį’KńµóŁź„$, #_œL°Ææšü“‰ūC£Ć¾8)¹”BKQS óø^ć\¹ŻüFŽ?NǃŽ^«o‡ēĪ#’¦ē{±ĒÕĮÜéWWą†2ĄČ.z¢9Ą §įŪ?x2 +\8ļ‘ŒsiąmrŪOWVW³ÖcSkŖyņ%†ņlOŸė6ŚNęõ(:@;;²–„=²r.ĀG—ź"éŽpSm£{ V­†‹”J‚WIõa/E3)/Øyō|Óóį,»K})Į®R•f’äld_@Ļā¬=Fq2m°¦ƒILą€ķŸé%Š’ļšÜņRłéįÕØowD_ŗĢĒ‹CõøA’qš°.B5Ś2ÜjülhĀåąŃu–„?†c?īFæŸ÷bĒ„gŻĒ>m^ü…@8"y0æqje?£E½_‚_§8\‘.½īŠ +†ß”¼ŠXcįę*õ1LmyķųļD38ĒŸį–ŻĄ­Ö`7'Ą£½ |nw(ŲöŅŌØĄ{1ŗ™HŠļ¹ÆUh*)6²V”s±ä˜PdØČl ų‡ ’“’ąl×AĖU-/×Ā=0܈"(­bēŽJsŽå{špååa}mué,?Ų$9£Ćū£Z¶ėĀt¹ƒz7ÆĄ:ćUyéØ+‹u½ä˜¾Źņļ|ńTó?օŠ»Ō;&CĮĻ@Ō0+Ž·m‘1Uµf¢ŽēŹ”‚ÕK€Rs`r»"’lZģ:ŃŻ3›° śįŠŹ *‰½f¤™+¬ZV Łp ©­Y hYjL mĮ7ps!w~Wģ7?WČjj¶%ōĻNŽ7}T­XćD©»g>a›ÓYźŪŗU°ńļ0‡gq7µuMS-v: -_­3¹-¦ŽéŒóµnVžÄĮĘwīćØßŚåOĢ2¬¬tōÅ»‹Lm ‹Š¼Ų— D#PżFWˆ„‘õ åÆÓ•Ć¢.'V+µÕšCq©{'žĮ9žį›&maĀöīąŽk-'Œ6’ž#m[.”~ĒW†Ø6 J{Ń ŅŪ“I³œ“k•.KzO ÕUK ])|¢×1ł7qģJDؘī¾ ¤N”[{Ž4Q_*¬ŁŅ«žä9jGùڦłÓŖµĪą„“_ :Ųf¹²]ŁĪ4źöv/ō «¦°CwE|q¤;]ˆXÉ-Ö—’š,é0c&€ £æžÄäĮPܦ>‰Ąˆ,ļP\z֋YD.DóćP ąF×߃1\Ž #‹\„yĮP•k½(•L:ķ“9’ŻYäØžÜÖTśč§ēĄĶęgż2ßõŲ›1ēĄ½$&Ęø»‹F”PX}­¢ńž¢;ĢzšoIūÆéĀ ź󐧤`'"3[0•kģēą/\Āģń 9­™ š ĒUš{f«ģ~*ŒyR!š+ÕYd|µImŸN"“Ć5ōńś_Ų«±Tŗō„}˜Ŗ„% ÄķÅŻÉó™9@āLā!”7°QäjņØ'ˆżŠŁ>`N&Ø8éĶHZ8œŪuę'ąą÷'~!Żłę_čõŠ2¢õ;‡«Łņ°=’̤ŗ^†€T^ė¼·c£;°M¼5=“–»‘ :ė£Ć~[Ch÷`J©ĄŖ8Ē#ņ‡iĀŁ,šnHóƒbŗI“6”6lČé—! [žµš‚}†x«<æcąŻ»ülūDš•uÉĪ2ģ7ŽQōöik|×a#摞šjx„š{—0ń„a³Ź@dN^›Ü€R ŻBÕeåĶn™gĒqvŽuÕÆ‡`D£®ęĢIĒaĻų$0>Ń=ūØD ėń„(QŠ~q¹7žzƒ²~܌¶ķ˜Ftt×i±'.(ś"[“a !…yƤC“Ȟ×=hĀ}Ō „øä…r# ’æ«4Ø/]„9 üX9*Č…AavgŖīó ³}Ž{møöI'’Ć[|cd Ļq[“Ź^Hoļ÷ń&"Ņ‰qRųkʜ漵lW¼ą2Ÿy˜os£)Ŗ ³ĪBm•}9ÜŚķŒ[q&¦Y®Ś8]WņK‹ŗ›Üuō”d$<5^n„ĶÜŪźĄ!>6®‰#„p(ĀE43hr2²ę1}§Ųä4Ģ»eźؽcØĻ +Óx’1Ēé mæ›X¹EŅŖM‹­nČwSc,s’śĄ= ?|fdYÆpÅŚÆsHåDŻ}qg0\į’ūÆšūY”€ØvftWׇF‘õI$©!É=ĄśĖ#`-œ-`ö,æ€@°…•×z¶u< šļ>9)ˆ—„e`12Ūz%„•> l,^{ŲĄ½Vu±ķų7z5Ėē6=X¢˜»Qыm`“iK0 /Ʋé±īb7HūžžµūÕĮéņkŒÖĄP‡TĄ¹#ŅUź{f4žjŸ {ŹZŌၠ}p)9㣤ĀßĆ „—nž–dM„¦Ś‚Ö ŗ2ēÆ*p½ĖćŻøW÷~Ņé¦U ?é¦ē ĶÜč³CĘ”0`ÖZ;2<:”ó:”KG29Tč›Nq]ł]ˆlJņ¶p›49¾Ž¤Ļ_kŁ•ÖsÜ.ĀåץֵĒł«Īœ!ā±ž¬Qfź ¬ōīĖ€š‡ž7"gxśrĢ$ŅÓ‡xĆ’–z—žš—–Ÿe«öķhVYū%e’5’¹ŅXB…QĄņ˜~JŲ×y’ļ$°ę®ß!Jަ3F²9$bē>g§:D06¦rP¦ĄBŌ&d]AŅČ p-BBĀ%2Ģ„ģQY½]ƒ žt Ē€&vU«]ŠU9=­‡č 0zb1ģPFu ”;ėtÉī­Ä‹k’µźĢL„ū§5²`m„ÖŠŽ”šD~ĢĶ‹, ±(—„-eG°4-”ŹŠ×¤‡ųš’iųaźaœĪŠ`r“…TpĖŹŲ'†VųŖĒ‰’łÉé~-Ć%+€(žÜۃĆÕō3{Eż„YÆ8˜c„××,Xnƒ¹Ķ¤­čh‚ hT»ŻT·lŖš·Jlłø§`ló«Ćč±öąN£“ŒŌé’3rJƒ7UńDcĆ£Į=’š÷Ÿ]Ł^ØD>6ér{Ė®¼+Łž.†iā8ų²*%ÕŖ€—8¹Ķ.ī&eEƒk  u©ų¦u|°¬†¢`ńŹ£š†`ą¶"O7ӊA]H„„µĻ\wŗfŚ`Ī9 qĪZTvŽd„Ō”B’¼,„€ńVN.xr_¬.§Ļ=k³t#É5¾ŠuĪŪČ*>tĪæX¼[ßóuö²õˆO–n5'ÉĒĆ ĒA$ö„[lj Ś‚%™7oŠsęŗ]¢óęŻŅx‚«ę³o&¼Ćå< µ¹ ’"ᦓ‹éø¢(eN&uµ2'fĖ׳ā“mB½›ŸŃØŠ’³)ŖAƒ?Ćö Œóž¹āRo­NŽ pØiS™N„ģ ŗ‘XpķF—VOĪ{æ-\ĻīhĘÄ0"c‹»¦v œo2spņĄcģjŅx&_rźż{BæS×o¼vC å #ۜ0xkĪ®;%„šz ™śĄrPęœę€ ÆFWNX°“-üVµ³6Eó.VēC÷—¾k{g§8u‰Ųnõ1Õč{bĀjIaé‚M{–Ųƒ~Üņn1A›ś?ļϽčI×mYM"?ȱ=€ę é?V—KŲWĢĢ[D<Ŗ±Wę uó‚²_lūÜŚ oĀ„[Ż€‰Ń¤厇ŃC_rČrų؟Ū3Ļo`rō„aūnŌiøāĻ7łŌģ‰O- śŚ£(?ż„Ö±žŽüļ—ĢŸ‹Ü1¶ä`–š?ŠŁEL°äPX»Ŗ˜Ÿ}ÅČn„b³F“]ōü4V†Ŗ‹DqĶDœ>|ŲE–IV{eĻP’bՉeĖe{O“;ó×øŸo.U ‡™“س’8Ł*ĪpĘ{ŗ±Ņå·¬ƒ¾!0z”bE†rś™…*wmqĄxŃϽJš¬–uPi ®±ja”ŒŖÄƇČR«R9Åb‰@ĢĀRƒ’óćsī­Ų²pā;Ń”S›p•eŠDdÕTæ[Ž0Ø©TMøe‚żčźĘŪ(Wlöa]haJæP¬³ƒß=N9‘!Aüņ™ÓĮƒŠfžf6mĒ—ž„õq'ĪN”† 7АOŅ(äķ]cB™Šo¬Üœ«iżßĒ8zÕ#į™x]Sb‡Ž°¢V.¦rŗŒ¬@*<öÄŌZĘ’]īMŽ£Ż,_MˆYuŚ·7׉0ŗKæŽ-(#ÆÆ"BqŽ{6)uµÕF±„xkŽó®„ś†,“Øķ&ם‹­oģ”R܀šPe®G”T4½o§VN:É7ńešÄķüŃ?Ķü»ėT§—_ŁĮŌ%ž½ įU¹ØXM^•õĶa•§óslOQ š%3nø²y߯ōč]Ür=_vĆ:–Q ŽŅźH`sNš’ü=ŻžłŚM+–ķģåz45 l7°yµā}ė…„¤zńŖØuaŹ l0ՌR5)H›©tbżŖŁ<}õÕŠŽ ļ/3óŸā”Fb*}Œ^ż•ĘP^ąŖŌZéÕ$čzĖū'ĆŠÉŖe ›mšŪō© “p™¾z1²Ų#“¦¼CöuāļRįńöķ1ś|…Ż%bF¹’ęR2œ™ch ŸjA¹ańśt…£gŖnŠ<*”ŅL÷ļX?vQßŗ/5ÄŹĄŌŖß<&²)ŽuāÄÕ1ā¬2–®5ȋ ē|üŃ¢s“Z Gæš Ēr Ž|DÉ tƔJV0#"ŒŒžabåžŌź ¢¶yåI€Ż.^1Æ­gHˆŽ3; WķEś”~óĪ!;ž[C˜•Ż;Ģ{›“Øö«² I¾Sżpā¤äœ§°ņ\ŃŅ'\gšGŲCˆģv˜›üِÄļģ‚o›øŁĮŗž—¤ĄÉµÜżpõŚĢK`E…| ˆ%ŲqģłB ™£ļ€'n²Āj$ͤs«ęaøų×kxĢH;œ †ßÆ-"i÷hśžĘØ. ‹ČXeÖü³ó‘]©IA}Ŗšsŗ”Æć9ńĢ'«öČ{ń¤DĶū×uµ †ŹJÅT¼A_[Léß)ŲmĀĢ”q¦¾ß4ŗ®_œéÅxČ12>'#ßjYČĻųٜ¹uĀ"ˆMś§{õM£a›ŠØĘU(†/óį¤Ń ‘cĀ»$fEøüå‡ė9†žG©*uZgaān_Df„©…Z4²ī’ĄrMŹ=LŖŠAÓx“ߢf'ˆ¤½ ÄčbŅ‚=w[XNHv9%}Ó°Cķ[œņ28‚„†@*dŅ…=؆5MD­ń‰ÖŚt4T’§éĄ¼ü(µŚž–*mū]9īžļ0\æØČK+õœ*ž!õZ[5•U5Ū§±Ż;·Ł>ļµ#AÄŃ%šre °6R¼³g>3gøøµ„ĪEŒR-å ĘKś&-"*ć*^– ņ{&õXļ&Ē’Śœgj÷*·DF¶fĻƒåB ć\Rµ6ƒZ÷ŁQ£JŲ ćŅ’Vk+YŅѤ 5““öaCōõŃīK·ģ"ž× xĆŠN&E*’=U7O›Œ1«q%PįSĄČŸĢ¾ž¾ņ6%>0 ‹YZgraph/data/esetsMale.rda0000644000175200017520000016027014516003535016230 0ustar00biocbuildbiocbuildż7zXZi"Ž6!ĻXĢęöÅą|])TW"änRʟćXa“ĘqÅjnēj-' ½;ĪÕQˬŽ:„r¶]SŒ2£—]«Ń:ēŒ\.ś†.‹I fņf5ŠŅ=ł6»ÕrVŸų`+–™ö¢”(Ŗ’€)›Udģ’æETEīŽČFšų 2gŃx+T:ņb_Y™ᐁ[<ˆWC¶Ż2Ph§ Ÿ‹f•ńäPį=ęĖ‘r7õ“<ąģŒŽzø5o˳(”1Ÿ?énW‹`H‹>}ZĶ>¾"±7Årš1+u^Ą{IV€°w'0“6r+1Ī å^cšŖÓĆš_‘Aµéj,b–µ:øĘ§_ ÷t–³×h’žŌ5nUü vłkŖŹ°%ŪÅR !«HŒO9Ś‘}éÉkyp6ģ<€ĻčG.ž­æ4ÉDYś„}sŠØąö§Š)׿ć">ÖǛԇæČš. ƒ+:ß5œłŽ²›2ŒUŅ2Ņ6`·ęš¬:Q’¢£wą ńżge3ZļqŃDĢ©r…ĖTžż°}° źän‘ĄņģxÆé č,Øīõ_3#>×ÓSN™N\Ø:é«-&{Qƒžė„G’i(É”‡ÜĘżr/Ü"Ų…Ö“itŠ{¾Ć¬)Ļ4÷x·Ÿö)X«>ćŪā+A÷ˆ¢Ļū„sžvFč=žEó˜(=2±Ó½ń"˜—®ĆN&Ć¢£&oī܆Fœ’øw~Üįv—ׄŪD儎F§WĶ&|Ÿ%’˜eŽĒšg¹²HžR7õŽćBć$ŗ¢™+Œ@ź‚ÉTžd{¶ƒŖ‰u"×GźA_ą—žĆ7 tÕ<ĄĆ4ŗ¾g¹]ÅŹC֒^ö¢ X™Ųo *bKÆÉœbńßŶ¢”‹ż]Ÿ“_‹%Wcm¼²\× Ł#q>#„:PģŹ'² Z%źiŠóŌ—8āīł””菉óG%‘”dś}Ūa~ēįS·88OJ©Äg‡żŪFd˜™])}ķZŽ>B„½ĒDĢl§Ģ—N«žł‰ŠŽ]øX|ŒÆŪ™žĀ‚śĀŪ:ŽI½×6CqUTjq żS>éõP™œÉ,ó£œ*ŠRiŅń­&ŽĻ%mA Å„G•Ż9¬PMēlұ€Ź„ļĄ+Āö¾b4„}Y~Ķd3½“{øQ… bn–R:ɅØEŗāņG ”˜źgwŪߓ† żāœ­‰Å½æk,X_ēĢEš÷ā<`¤6Ü¢M~<=gT­@­EÖåĒ“m@ õ–*åŠ ;ū ˆč*­•U˜‰“E1…"³JXŪ”³ä×foõb¬£äC7g®ūb:R3åʙ/GŁŚÕ†!EliøB9M2ÉÖ2]ļ9ćKĪś€[ˆZœ0¬ļßīŖ¼×€OŚvÜ(1|ö£ ä’Üå†vķͰI䏩J0‹KƒŠŒŖaj “¶bŽŽ€ƒ’[jr<.UĪi¬žō’ifu8œ­Æ”$§īm•œĆ8õå€{®ĒƁ¾™]0StŽĄź#f}³ Jj˜:0ژ ?=ā–\ižõ&ģ”ķrÅŌ„ƒüš­ž÷WKÄ4ŠŻ½p²įāˆóyÜß %ł7Į–±ū§k¼HūĮf’āK9©d„‡śńŲč+A÷ĻŻĶ:¶®›!ż%§Æ™`®:?tłN98–P0šĪüŸ‚‰āŖw#Ōh§ą|¼ v—Äo\k”žź&"™zbFp|SēĻbŸœ#‹—U¦¤²¬ø§³ĪŁ 2Üs_x•„Yæøŏm"#ĆMŗ®ūN ŪÄ ä¹M”ķŁ'‹čĘe[örMœF2¹u… ‚ćć-łL0ų¢H‰•¼vJłŽw'C* £’s^-eŲāµGõ#£TēNˆr|FČö;+=ą^8ĘĀ?‹ø6~D•ņWüg<ž„mīLšÅ®ć¤I/J?Ļ’ļž„M•cņčAĻFn@ąI'Żę¾āė6— ŌČ;ÕøH\Y "”–"¢£mD Člb¬­ž†«żõ¹ĆDU©žć󅟱r=˵h=’pJiŹ.cé;ŌėĪ—ZSrL€x[ż˜g6wŠ" ü:’‡qĀqf‚2X.óśįqCWNLŻ\qņÓšī^¬jMįæł –7ts!¶\¢’Ŗ+ČH‰1" W H“=Ä0{͘kw«ŠģćKĖō¢i{ü>ōŒķ³ĪS Ņ’Yāń+  `ާqūąŠ2ŽfÖcé(OœŚ+ H²­ł=r|‚-m•s:YRĪ’ć¬i$ “˜0_g}|IWźāƋEŒš\>żĄš™"ƒ%M^źW*­NvNł¼ŒÖ »ÉjA”Õ‡ä~BwA‘`ŒW2ΜųšÅ8#Dõ€5ÄfņěŻļ±÷P’¤€Eäįł(F\Ŗ !u[bc«/Wķßæžm‹°E”sŽÅ˜2~ü ‘sg^įÆłõ7E Næß)C¼RĘŁĒrŗī"ō©eĘą¢ģ…PõŽ źYĶż¬U°rń@ŗ‰īP…ūŹĶļ--LÓ“õlC`o Ę锜D—Ä ’ÓWęįÖāøčĪŁŻņ^&.Õ dN˜·ryū,5ZuÄĖ,,’ygq™š*žpĄīXdB1Źć¤§Ōž’G½- \«¢²ĻÉĻIŖ$®«„Tbł53ŽÆ]ndŹ=‚ū±„錑£Ģ@ųĘ_æZѕ•£Źk‘oÉ#Ż Os%_ćŲ)(i5”āI„ī—č½ö9ęĪeįsFwŽž5jŖ z~ŗ²óģZT9JÆ>³a2,¼Ķōұlāłžó;ŸõĢc±_Āb«eP^f ‚“§Āc{°7īŠĀe¾\Ī2hņ5p3Päk/æÆc.«°žČÆrĄˆćJį“(Œ»TڵIˆšFūWĻIĖsńxčߎFī\Ķčj(ş¶ŲŒøxMM{ķj­.g7ŚełÜČÉō”AģÉĮ;Ī‚>Ė{‚P rŚ5ĪB‰Ū,ŖJ0Ķ™…²e6“Š£_ċóörõģ‰gƦ¼ņ ĆłS‰*ÆhīŹj1y‰pm,²Ėr†U‡•/2ģa !B—ÅńTŲa[÷µĀĮ±š &ųžÓÉ>3E T3‚ńyw«Éq…žż6½N,¦›L Šõ 5«ŌĒ0Œ÷óÅ̆ÓCĖf5‚,É`ė%ža/ˆVWū¾h„_¼:š‹bųvو¤†klŽ„)~×ōÉĒ ą¦J–qģ‚Ń×+ Ū1§•ż÷f»N‚Öęód‹1NBöCIŚN+&0»‡ųEēIŃžŸ ŃÕĀzæ pÖ[» M—|ÓĻØßń¬ŹE° u¢`½ƒ~zŒ‰W¼ Āƒ ŲŚS+`œR°ŹāC‘C·»ü € åj§Pŗß²ØĪŹ·}Īü#•Lpׯ³Ćˆ=j ĻKŻ©ųĀ~ĀĪ3Æ¢UÖņ‘5·µi»„¾ Ļ"BéIŅkk&Õ¶ō$H–Õ#5JˆcPÅ,@A41" bÕ®„ŽNd;—[Čšāˆė6ĘÕC?p4D~€Ź.ĘI ¢ĮA½ū[¶«»jóĻ&#ÕNę]Ö ‹1€'då ölh9÷ 4²f|œ¢Š¢¦jcÜM'Ų ü±"3˜žµ”°#eä!ĻÅ#:Ȉ{TīkeŽq‚é›|ΚD¼˜ķZĆV™÷oŅ”8āC“7Įšr‡u•źÄ3D5L=}ü±¢7&žK9ˆÓ»VųoœÄ6,¤’=ĻÆ–Ą’M¼¬VģJōeķgay>vMlk‰ŁPsoIÓļåš:u5j­“ģ­,Ž7^ÜłŒÉQōžšOĮ`ė0Ÿ„8±ķÓ>Y‡:lLDzĒe½mA{^-P¼›ü©čLüb®oĀ-ŗīŖ/~Ų*»W<ŗžZ95ŖŃuĒB^ĀÜb§FŪ›°(’Ó¶˜Rc~诌šˆ2ē~M)7ĀüɆ•˜qUŒžC‰Åq2é'’‘Č­žņ”×̤ż×jJ ʹÖboÄ©å2m÷?’Ņū”m9„vJć=Gł¶ĘįS¹æ“ķz Ā^ö€NŸ£t{Øė Ū|`zäÆyuv?[‹ 'Œ<|’łÅx: Æq¬’Y>ƒĀé:’6:©H¤„BV¬”PĖTĖĀ(fĻqŽ“y ėT øµĒÕ”Aj¢"!š“ŸĀä“Ņ!•į–px§zzŒ¶‹ŗ"­śÖÄ=X“Ķ^Ŗ%LLąU(d ā,ӕ p°eD7Āp×£9«`Ÿ*u€Å ®’Æįõ…›$¾ƒČX؟Ģ0v–)*n's-‹ŹĪ–ˆā°-F˜µ¾öńĶWüŽ^ķ\WŠ^Wq*öCŽ6ō(€)Ā~9T¤MRż·ł°3gl•oM¬‚Ź"ϤjÆÕ6„īńgpUĒī¤Ž" IÄ8Q[ļ¦g“dEƙHq#‚Ō“ŃP=ģ-„#© žžaÜI¢NÓ¹rV!b ¶ųųŠ`A Ś6³Ūųl^†ōūKÖ&,Ÿšå%Ńį^…ÜźŽ¾W“qt, ė®Ģ\ŌhĮxi“ī=­ ŅĘh큤æŅ—ÄėBé»K€(— 7ƒ%¬aä i×ćDS:ōs$®AqKÕ8āŚ²ŗP㳐¶„±c&BljiQJ²įŁ9̤¢Ž_ū Vē¦ńģ Ńŗ’'wI…ķgÕp}įŖ]6på·KeÉS­nćZƒod³øÜ3÷„.cø5Jń‰Š&ĶūgŃa!nö1Füˌ·‘¼jäÉ·e¬‚ć÷(£ZØÖkŪ8g|!w ¶é1čšā¤ebnĪčŚųöeMŚ…*BDIČą”āÅƽŖŻD§×f˜|ųY¾?Ė *rō)L>¤üØ{ØBęFÜŖŒa¦:Ś…¤zl­N4 o”?§kšI£Ó%‘lK˜ŗŽ”žĄž]ņwįܓ=±³"zX[ÓōŃU–µPc3ž ‚}Ļ7=‹.ÉD%»4BqöfA{T}ø•ęÅ\Ūvē ÷omżĖ„qlš2›| (¤Ā4lĀźŁ­ŸŽŲ_“õ„“3=ŚŠCŅ‚ŠbB@¾Ņeœ ÜŖ :tæKŠ•źWŒ@vaU(ĮŹn/’›c‹3(0 ’:V§;yŽØ„ ē$Źü`qE8CRĒG5cĪ :Š—nMg¤_½]†&Ķm=³“m‚xļ„kķ+ģŃ[ų£l)|4³¤Į"z/H~‚OŅÅ֎;ŲDÜa]oōÕ,Ķ¢p…EM3Äéæ1kśQŹŪŖ}ā=ē7™…5l~»¤„ł”mˆŻ:³Ż¬śŸu`4|U³HVµ›Śī §(jꬒšŠ’{7²rźāó°Ŗu"ąĶœ%ų°Ž5}óĮĀ!$™Ż# —#^·ż ŽhŸ¾N„^XÓWžĮ( JįfC’k«M`j¢v4ō+^ó“Ÿ”ūĻŪ‚fm¢aŗų®ĒŽnhžé7ödƝć.µ3×~Z[OÜ\>;ŲŪ8I…zASƒYĢš.^µm ĻÉšzĪžŌ€–Vėŗ]LxVŒˆL¢hµmh#±lĶFÓZ;Ņ.ŅØÄčū_¢o?`מĻ|K"±ČT’žmŽn,Eė“` >Šn\Ŗx•qQ/Ė(īßt°ˆÅ×!Õź^žĘ ŗN˜Õz-VŃõPĆč]Īžžä~Š«żé¬\6˜¼-AbŻu#¦ č|Q+mĆʎ+1śA…ŖōifQŪ•ÉŖ Œ…¬DQōģ=ēŻ£ÓØšƒmą9q‚E#īaSvé¦ō“żęŹģśżš•¹±OüÉi%ĀÕü÷!ĀnŃüś\ĖDŒ!ź9•c¹j‹×^»±žfyŻū$P*é¤öDć¬ēŅ“6ś,¹£õcż¶z–SŠ™~;Œ#&ul1;’‰¾Pšø7ƚž~÷ą‹‘< ʱ=ųGz]Ą²ņ¹žäŗ;ß!ĀN±ae„IµŁ (MæFÅP:ģqtž¶b–uÆ -›Y9±Rī€@ś:Ę£c”£˜vÄŻ%Uqˆē0®\õAō÷&†:28”Ū(BtĒłr‚±ŚŠ:µŚ1t.iµšų ü”žbb¦ŅłĘV섵2óM\~¾Õ0,å™ ŗ=Įc9Śß«Łfeą†™kRōŽ?={%öp‚£I+¼ ĆTæłöŽ«EąVē>‰§Cœ_g™%ĘÕ|ŹĆ&éP•&|Vˆž!ųŽ¼4pč>Pł š|R_B±$„^ą!ø2ļŌĪeŃO•Ą£ŚuqʅšF5†eŽźV¤t7BŠ=6žGĀ~ŁÖ{§Gö<^ÆZ0ĒĻõ±ō²ŲNSx;«Q‰”tŠń—Q1­$żVœņ€} ŚŌf#™^ąi¤†„–³ī‘o8hē)‚y‡ßėĖm“c9!Āé?]莧ż’_†ŲåHR%$‚Ł %iŖŅN}(æ [›MqŽd{Z  >\ó×=„ŹjĻŌ¾ų''Z4ė%f&-| Ńø÷9h\‰kęD7/7ƀ<8ž@Ī7ó<Ā`&(G³| h’ y‘&pRO°-Ÿ!!0ņm°ŠūÜÓKūļ÷›2ń‹pÓ­R8ĮõĢtęµˆrDØčøzļzZ?U)IĮĄågŽx“¢d³lĢH‚ŠĆR,Ł1£•“bæ“xƒ²×ņˆ¦W­-dmŗmg®±.Œj·ŻĻG~+NŸø)ĪNŚ7O8,‡ śŁdÖż–E2U‹ēGļC©”Ž1s‚‰I„a«ÆmāØgūsß±léDSI>æņęKņōvīŖYéŠÅMr³sŁP[į¶yß§Ćī<ā'–²>t{Zøżm[“śCE“ģÆāÆ ļ%<ȂåūŖ¢’¬c’wR†…Lrąģ$W\ óüš‡ŗ­”}£$M " @”oĆv8…”.YÓ4+P×;…¬Æ°õ”.xtųź½c;œī·/ަ$Ęķ3”I£}³č# †ü!’Ū£µĢhĄ½¢‡éŽ¢|Ī.Tēko•ČɐQŖÕ§ēāéžŖ%zP(ĘVmƒēÄõf æå,LĖb›½Ś¢w¤•Ż“t “ļM•$÷†īń"tµŠōńķ®­Ö„rī­e>mĮ˜÷œ0# "l.ē ŽćiM¦œ¾%•S²D6˜×'!¦ŗAøA-ķn®^՚–VہMRY>‹t騄ØWf”X9£(™ HP'ĀÜ.&hˆcąBr5N“pŒ˜ė“ĻV£'œ«ś$Ź· ę:Čw²ēv "Ō¹Ö¾9‡-ķ|Īé²~NISą²°µ[nžéŻŽ>G2ė·*Ä0žÜ§k‹QoLPę–!šbdˆ×Ó×’%]T0j-…EČŽ±Ćąƒ®öĘĆ(œśŠ³yPń{«BØ¢[‹pbj—#;-•6'aIńÓ:NŹJKĪĮECä*4Ļ6L[ķŖõų4Ré)ō—˜Ŗ†ū-¼æ›$&6 żĘ\u”¤ø*^čaT.éKĒš:Іf˜ĆUŌ0š•j”„sZYŌ•į²h·ˆ?,iÅDŅ:1†Ē—£{ųģ7 »Čó$4½¦ä7vŖ_†6>¾f-vā+#ĘMƒŅīBY£»I}ßjs ģL̉1ü‡dĄEÕ†y†ŪPwl[–ćęwŒČøÅ*žb|’Õ±ū?¢6ŠŸĘõX‚cŠ˜B@ZÖ¤Æ;ąjbåN‘F†–žÅf@Ö>Nčä+֯ה1ԈóTĒizx0VyӄčCmHūžĻŪrY2ų‰ź'ęD:½ĘfÅ?‹~®ć0}Ieq? Æ|[7~‘Ól—.~·'•Žr&8WuŪ2‰8luCT'nv몃 3¾ÄįiéNyꄵąKMb_åA „v …é’mµć&5Õėų5MŠĻķŹGÓŌ§x2~n„Eął©·QzÄpÅĀ«Ųī;iH2\šK”ŪźA•FŃ6 §n#+iKŪ/°¦hĻÖžīŃą5µÄŠjPŲr²„Aę2šc…œŖ{ĮŒ.·’”ŗl~Š4ˆ•5wۈp"³n˜čD®k܍½śSšŚDbS“АJū™źAÉäö–L¤Ų§żKF’@²6®<äŖ'H¤ŪaF2mYŃŽ.ėļyĮQš4`ƒ˜ūÅQŅŪĪb[N~ŖŌG[!%’õ–Ÿ4޹˜Į,g†‹‡<·]ӊŽZßūģ,ūlkŠq.(»>FsĀ›@Śe¢L£i [[i˜pŗx©2žĮZĒõ+'jĻV¾Ģ5ugæM Ė{8ų±мŲ&’ŗ¶;ēצ‘ÜŁp¬\ž+‰”qĘōI€o’@! Œ#Œø ‡x4ņi+Åć G™;”±’ƒ(8ČŗMä ½aÖĮZAāü®]žqŸ•0®OčĒŲ¬¢?jp?Č„Xņ©łrŪŹ&ĮÄä9¢?õ42¾ō"2ŗ^Ź—ŗ’ hĄŠŖŚĆ“F~­Ž0Ŗś)C“÷˜¶ĪYĪž¹Sś©°‚ģ $\Cæ^N•YÓÆš”W]£”„›CŹPņ„‹wŻO‹ éēõēūžŽčŻ$Ün$ŹW˜c ¼z›ūõC˳ 8½“ VńNÜ) 7ʽQÕ1Ž,£tĻ’ElśĒ®’SfCĪ/ä1š˜£w™Wš¶Ž-śŹīēHÉł?wŁXćĪ€ŗŁMµÓ!>J“Ī“J,)>šź`–b)Ą…`Ü)#¹WiĆn¶·"Oµ”‹Ś>+?U«ÄUžUĖŹ†vÖ\=)³ŲER`ÅĖŗę@sÜæh¶†ó….ŋ²“ŁÄšjaĀŌ÷Ŗ¾żŪ³"t5D¶l1ÕņpöŌT£nƒŻęÆB6Q——8K}§JŃx … ķ¦dņNF-;bÄš„ņZ¶Ū#”Ķ #čC+Ģs'žė/ڶ‚lJ9;`_†2ĢU8ŃŪ–·üµˆäĻ f&ōn#^•˜ģ—ęuēȟ×wdš"-æ „ŻL‹æš|RL⤄įŒÕ"„vę:š ŌB„¾Õ‡vó->Og$ŠŻ¾H”ēŃ“žļVH.¼Ų©!ąŖĻ@½M!҇¹b Lųčæż × $ŗ‡†¦~Žž×SėéŹā?’qüUg–v0¤Smה…?¹{>”®Ļ|ü¢č× ~tĶšGץ¾õ²*ų8å8’{Ōt žŌtŒHÆ©¬ĒŹ«žg—耥ö»¬°anŠęg‡G‡f3›‰%AKc-”•čzņsÄZ„ó,ē‰U- N†˜Š7W›r-˜µķģŲ<ņ˜NR“œõDŲģ†$V9=“‘ E<Æć°vY» ;ÜΦ˜”tÜav`Ā©Ŗg_» aĢ Ņq2Lq  üKśM›żŽS0‚i²vtī,”<ßCŲ5ߏ× FŠį cņ±‰čmĶß¹ĆU„¶įz»A§Ū7Hü½a€jų¬øĒ P,Œõb}\™Y;ōeM¶‡xrł” öS !¢ĶEŚkķ¦‘ĬC™$}į™/¦D„Žvģ¶ŻéfCmgČ¢a›…Ė1+QL¦Øa¼šu¦T3\‘€Y™M\ćW„”m@ÆÓÓ=„Ū%”`Œ٦BLčvå1—ō“ĢIĀF¼ó/åh*]7\āß»LQä¦!Å„ŸSu?ÉĶŌĘāōé’"Š:IMFšz®“6ŗ‰Z7šlŪ …Æ­oć•Ģ|Pēa,†pU Ńˤ^Ü„’–ńŻ„Có‘!£ÓŠF*Äb<Ł£2O éØ&n-į} o Éļr[žN$KOKž©®¤ŃĀł£Ź~ĮŪŠ6§g·k`&ƒĪƒvFõĘ6ņ5qšļ„zĆÖ¾#ņ¾g?•b ĒŚ•;ƒex<„RŚĀĶņ§5ĘDź(A€,ŅóLćU%ž )ķI›mAD`ą!m)4ēŝ17ĒY®1ø.ć·°zŁĶ¾‰nĖ<6害ޑ›ĘÓŅĒ+78ų,œķ›"D5…)”×eė³j>&h}Ezó…æ(‰T²ņLi•—č®÷öü • Ģļ„ł„Å Ÿņh…,Ķ’’Ÿƒ2}ЧˆĪ—MŸBlĄQb™ł#%äšÄzd·ĢWßŌ5ĪÓėĄ5;˜Yżż¢ö:¬0^dŖLĆ~ķOžū*ą‡Šw2õdh§„ķ¤ø<µ[c„yMöVF#žR“śģ»¾¶õs$óųź„{‰LņĒd°æŌV‘~‹ø=U0Æ~Œ7ŠäØ×”–qOŒJkŽdK°ö®4‰ nćV ÷ī’MPZn¹}uŠŁ”#Ó\Ę›&™Ī…mq½ō©¼5¤*V'9¦ß––ŖšČņßņ±ė 5~iā9xŹ…°7'ćž`ĘŁgs0SĻ9׏w`+”ą`2 D—”¢‰†ķV7PdÆįż}4ŽŠū •…Qū½ŸRm¼ydVķi L­’„7Śzƒ3żĪģµ?ŗŒ:UęųŽ"ŠHģ—CXŌ2Ŗwhgé0]9ĆÉ÷ēŃĖMōÅ®4¢7˜ė|Ąq»D7n\ā‹°pŒ®4å؃"Ų6ŻMÉę©«X6”¤ē€–éųzy{ŠĻ$RnAD}’üēŌĆ­zĪtĖ)=ZėhĖĻōü`r‘üz™3’bc®7F')·D©UīŪ%ŗŁVŁGĖ^©×½T|PóņķĪ…ܲN*>¾Zģ{ĻaŗÉĶńD·ōe4Ņś¼UB\ēł2z4•ѵń#Ļ ļ¹Dć—%[Xatz¶\į24/s-’~†€™õ<³śąx`‰€.:±¼s,n›šło€ƒT§ŗžŸķLAV·}¶%”9üņ© –—OY1«ņģ–qFĆn„ļńf#ØŪܑø±[ÓĀłwXō;A£ĆQƒ%n+;7ä„ J ·ƒæŠ ]P9 Øxģæ–@4Ķ%%ö)Ÿwжkiæ™—ü#>år0寋IĒš‹x'u“É£Ķń4jGņńĆZķš…ÆĆ_Y+uÅtā”sļ–ƒ ę°ŽąąžU¶}+C+ėŠ,Ŗµš¾öŲ»=·Ū‹ųrLqÄ!ƦČŪyŽĶ~؆ޔœ ·óÄŃ(¾J‘ŽŲń'¤/Ś·gyWwŽq™¤mEĒ„s?A3Ÿ_ƒos(²CÖ ōeš5vf:¼‘"īQ1Ār=• ²®„H<“Īj|(•> -/F3™LGö›ÜYAÕ„æĒłyŚz`@FB ÄnżÄw!j«`E¬ĢTŗtÓü]4'¢'Ź>»möłŃĶ·ˆy+UžĪķ[uĒ<ÄĀz>\vÓĶmr7˜ Ę|żß^¾­¢Ui°žįM\³ĘŠ8ؚāśpŽõgœ^#sū”¢¦šfČcø·_Œ÷ S.*Į¤ŚlŠēš”¹vńy ņ ēéMO‘„X‹a::•»óŌ“%t ŚĢt)”/sģe<uń‚f¹ßÕ#¦‘õŅ–µŸtFmžŠ:Ō2*×9€™Čń<=ūä;»œ*Øļ,“Į©Õu‚4“$Õ7¹=»QĖ|,Ŗ t—Ęu/8žYCˆyZKXžC²Ų¢C}‘øTh °žPŸ€Ó²KĘTŽ›——BĆĮä ćk1x²õʋ˜ZN`y~U“D€WCāź2š¾®BZE"ƤėŅpąūÓyēI‘·AD$æ!R•¤{'ƒ,ŗśkmTéÜP{ŁÅNŚXwĄx#8 ‘ŠŪ»µ\‘šSÕęŸFøC¢p²ńgŠÕžŅŪO4üó„žä8Õźexå±Ķ„«ÓĆšKNsūQN—myńĮ‘Æ-M„Hs#ø”X}wŪ’`ē$,čy#³GUĘiüå]WėIĒ0aĀhčrvFĶD›0OųĮ µŠ $g)•ąHŽg«hĢXłÖܳčĒģnķYóp„œ„ ²¼$Æ)+QjŽ£C`:yÓ,ōjŒ9LśßtžB¶„tP| cUå$s*™sģĀyęÜ 9՞Æk6,‹LóŠ#·ŻCµ“ūæ€ł5²tɧ4b9β’­Ćņ^,]|h-}}?P\Ź',g:’¬ĘB”¶^ZNū&ęrc‚č]SnąL"E ]¹„7ž"dåĮä^ĖRŽ)tI(?8ƒ mV«4k±źv š4š„5i…X}(h©Ńļgm@¹Nķuk.;O^ńŖŠ¹[óU‰2 2 ZńŽ—ĒkčQhE›µo˱ńŌGįĄ”›©¹ģ*µ°ģEš:Ét/šJĻŃ&UŽöuŸ¬żµß®‘~ Š^ž’ó_; ^Åq`żį„Ś$ rsæüŸĀ›)ü9Č¤ś{ÆiĘo¤ČīŌŁāčĶSWR°£Ggūö ²8vCābŲlucTSL vm“•}•Ō%*Ų t G'Ö˜ŪŽœÜż~Mž)ĢÓłP¶ŗõ¹P6žG½–ĒŃÉōT4ä@^Z 5bj¤¼”\»)„¦ÆŅj$&e‰Õ‘š i5·i.ūõ%7€Üt*ĻT½S„Xi[Ńr!mdŒ ÅŪä113O_īp]§µ:ĪĒÓĪļ?UKė1ń“ 0‡ – ÅåŚFWŃ5Ų üpƒ•*mL#|QkóTϚŌUÉę_K›5Ücn<’®"aõڹgaļ’ōƑ’«Ö"ś}~³™j7‘.uгūøō®k•ŌlrJüü¢ČPżMhxDó [{vöu@:;ļƒķ‡Y“·-ŲYyo¼µ!§q.Ló«łüj`,iѾь©œ!Oe?“2ßĆHt]ŌN”óŠn‘kĄŻ×½Tł;ī­“€ŅWÖ?6f0¬°®ü øft=[€Įž Nwƒv—'INćµ»Ē0”“Ā‚VNµ_Å"ėńü’oēt ;É'LqiT<¤=OüšJBc6±‚bŠF0Ų<¾•Hcy“‰™|«(sƘČĖƖGšb»Ž× $:SĮ„ø›żMŲ{Ī_šj×{@³ōŸS<Ģ„EŠ•7¢µDabB ¶@?į”šČńI•¶ øO“SģÖLŚC©A'JsnČ¢iL˜z;—ų]‘jh4DĢ“$Ļ•įK®eˆĖQSīźk£ōßsK &-Źtįm‹Y Q¤æĮy Ŗ*䌰WŽå‚'Mū EšūB‹ī˜r£Ą®C;°^Pjvš²#"A­}֝*чó„RŽŪ³ >£FŹ”Ą¤Ķż»юŪīŌńźļd`§ˆ¢Ū›±æ(. ²Ēs.‰Bó[ւ ŸmGćœę%Öź5Ä·S‚Ń,dēsĮ…Na,õ5ā}¹ųXpŠįzŗ‘摎ś6ĮĄŁīŻæą<ś0„·PG¶’'ÆPĮVmūóµ}œ­'lcV^¹HÉx{÷-e7Ž>ą§{Ć÷LL‚T²vĘ©Ļ<¶ h-œ1e”sOlśrOių’©ŽŒg›tæ˜m?€ Ń3MJõ¢aāģ×gšk4€ó՚āęŗ9ż›zŌ®ŁćmN:‰€\]ĮĻž< ÷ļBĮ~žuWP0Ÿ‹šYÜĀ:uJdę-™±Œ&SČ­€Y!­×3œóEm^•Ņ:Z"Ā(5Wņgź$ŻA“k)ㆯ įT”`„kÆŁ²ĻŗrŪs­÷ē„Ó[,”[>åŁĖĢr“²ŽżŁH ƒŽO1øµwSL†b H3ńtR°5ŚJŽ4žęyŖ‡!˜˜:‹Ęż9cŚž·U٧“īvµšeįJi¼OÅÜŌ‡ĻdŁńęł®Ć=ßīŗóģ[•ÉqEФ„-YļÄĀ•-‰QØ1x±)@øü*cdU ‡Pģė“S]W9śBČł^¼–Vä&°ĢĆČl½źµw> žƒO-†‹0ļĢBÓżæh€eą‚Ē]{¢õßw% £ųˆøIFkzĶĆ©«÷Z±tˆxś|-y",Œ~³-)DÉķņF ŠžŗƒŃw”§j7sĢJ—ĄoQņ®hļĻßXƒŹžØÅ•ĀœrˆlŒ4Š‹į¶ŠŁż_ö“)‰ŻŁ;)ēäœJŗlū'č]ŻlAč ļ50 –¦"'f‡<)-īĮ>­ä'*ī#Ŗ“ FžoÄ‡š«ŠŽuŸ^ŅėˆeŸ6|ÄŻŌ'ÕĮœOSY?’žóR_TĮ(āļ)Åū£½ĶLyäøž¶_=»ŠĆ˜ī{zՙĘxw-éÆå§Āņ^2ą‘­ÓU¤¤JUƒ„v𩚄ԫAūÅ­·gćzDt ź4iéÆQ¤cD€/?˜£!'pāźjt7ģŁ ƒz&T¶: ži£¤9‚t±¦ ™cń!ÅE§¾)-Ķ}__įÅ'?™ĄŅw˜ÕģQÉÖÜķć†į纁ƒ¦Ø˜(8W®°Ļ‹ø’Ļ– }qŠg˜Ė‚ŸN ³Ā­ŽJ{Ł?SMĖźU“²]n;pgų,M¾ŽŌ@?ĄUu ßD7!Z>sŸ/.g扅nńi Öd“P%ƒŅbåæŠÕ”RXȾLį§ G(8ōrOMŠa҆ˆ.tā§™oRŹ&ŃW“øĪ„VcąKōNc©ēļ`N _¾§ Ī„ŅW²u†GŌIj‹*nķgW = EŲ>­l'_Ģvˆéų¹ĻHD Ģ"?4 šĒ±)Ī;ߙŌxž5†h‰cŗŽøŸ­ą™ByµÅÓ‰’­øL‘Čč ‰k$²ø€ZO«Š ·ī øoæ½u’Č×Ŗ¼©†2¹›…Šø^¬ļ¬#בüŻōų­½č饳Č2®ŽN6¦˜Čœ’’ŠöŸ{R÷0"9I²²ŖQE‰¤gŸšøŽ7ČnPķĖįif”ŸĻ¶ c!ÖC¹3C¦`)±żāšG/¤ėÅ#Ü„Y蓏Z²ø*WRƒņ’k x{Sć«@‡½_҆)žU\85dŒ@˜*;šīĀ÷Öö²N ĘøĻßQ„ü~śå1sæ™4 ƒ„×Ę-C?E”¦‘Ę“\å ˆÓ÷Œō–¬9{Ö8;§w%ūÉØvćvī…łvŒ¼"‡- ˲¶®3åŚ}­:vÅ(.¶ķÓŌ…H«Rŗ ęs3U„žĄéćšĶoΆærҟęiYG7Ż?„²rR žętĖ ²/!zĖī`D3@¶tq3:½®ŗćæ:f/’ņŌŌw§jABž’°¬Ō߃pzENk\£u ·h¹”Ö=³ŁTł™Ž–Ÿ¶ ŹØ‘CjŌé4ŲżZ%šŖm_Ė|NI÷ų™Gč>`•isŲsšw'qŲĶåo; ³ŠÉžŚśGC’`s„R"ø‹„Ģyx­ų¼óĘc•%vłBü,4Å:¾ÖcEEŖ#{½§ū±-9==Ž-A-ˆÆO–sę¬jÆÕ*½ĶĄ®„Ÿ«(JŃę4¹ń5vÅ®żc#€Wm2˜2¤Åƒb±ŁMūu™v£’’Ś—O‰km66øn7‡“gIī±Ą’Iélŗ”p†œŅ< mŽĶ[åe Ķ:¼=)ģĮūp#@A®mCœ©©p!Ņ㶇ćʔų՚'ÆŠ‡£z!]Õ÷ƒOžĮv×4®÷R,e¢(Ę -Š’Y2>b¢rƒ®Ū°Ż{®4±żJœżĪy…„±Uó|rūapĘčm$é*Åå~[°™°‚pēŅķ8¼Ø4/1]QC*žīŒbŠŗfź«Oż łŲöeJkÉįĶ8­-ZiõÓ)+ż‘–ķR½’ˆ)‰q@¤¶ ³Z $4])6šņä&®v½Œa˜ęuöT™Ā”:£éõ4"ņ•‹µž_Wö†„³÷oųżk)}Š*]õėÉlź0”„/3Źo8¼btk—Óņv#ģā’H9•Įœ=v‹Æö¤`ü‘,ķxš(ØŹĀNÓZĘ9£C„łf0Ó8ķ„Ł Šō‰Œńd«Ż©&ŗzŲ÷€†ĀŌTq*ˆ쳄ķK‘Y-=ףą|Yüųˆ„"JÖźīÖ~”g‡uö§!čŁRŒ8V\Czō! ’ÜHb^9§2<ŹiBkrüäZJ{§āFXĖzŖĄÆó‰Ķšņź.#ÉĢžAźķÆŠsö–æSŹ?¦°ˆxŁ ˜JīØ7Šfš|øčŻAģÅ X`ō!ÖūčŸK^Ńå/åFLąŸOå“ĻZSwÆQ—ƂØėŃ^!”!Qļɜhyż$“<(փg’gŒw—ø%QC¤ࢳņ‰#%f‡ķ5 Å”¢L£;VSVō;óHœi;Że„Nż÷c ĀSø)C溘Bõާ§½.Ź›ķź2Ź„Ør–P.1ˆ#w°_·ĘįÓ¤‡Õ…Čš§c†BÜ É čéž§ˆ°¶ą‰c“˹Ī}(7 " U&'ØSucø¹łµŹetNž¶O1eš÷ÓįĶ* ßEÄ”źyŖr\ĻJwTĆżŗ“1:7pņy`õĀÕš‚ƒBYXŒŗŁ©ÄFØ.ēIaĘ&šxcĻŚP7źZłWĆcYNÖ“Ķ-üČ'Ģ‹ÉRšŃÕdɼQąŸ:Ŗ£Ā€Ü‹K~\֋/iÆĆD¢)ŖĒ‰‰?į½Kņe E¢=^šCü(‘€½d¬vź37h(勹öyK°ÓŁi?<šiŖÓ=b–©v]Š#¢RS°éˆéF÷”R˜””ŅŠˆĆøZEOĢŅ·Ō ²ńØ”oø^'27Gų6­Ó4õMézCw“z/ęk’‡7Ąs®±¤ 3©Ē„ęĢ?xśP("“„¦1ߨęėÄØślQ®RKX«7v±B~IĶ †ōR„µPRń܏(œxŹė:Č}…¤VčB|īŌI}Ą)L.ą©Ę_…Ė`—÷Ż©$ć 4Q“+&%‹©ž3CęķŗÄŖo˜óĪ“€Y »’x#Į¼Ļģ(.hѱ1+«Ł€*DaŖ;ZõłŹwšÕøŖ)Ž=S`‹ģvU’ūż‚Ķos„¶†X(±§Y¼éź`j2³Żs”Ü_ņĢÆėņóøłw•W ĘÓ>„…*S^,-ż|ŃŚ!HS枇ź[£ÅÕ.J#Cõ "¬EZxęš$²PĢ—æZR Į5¹VŃŲ<·?±Ā€k… !`d~śV±qÖ=ˆ~¬/…ų„h\ŻE ,B ™-…5¢3ģņö™( šƒYEmÕH”\“ߊ Q¢dIgóž4‹r`£ahBܳTڃ?ƉZŠ3µ’Ž#-½…§\[ Ō̇€Ä€U‹J†qßŪ\Ŗ–iźóš’ŖÄž—$k[)å‘Ćo­ögKä’¬ę¬B* Ś”*;„q<źųĻ“fę.üZS­vjQŻü8•įMæ»pĻ™ŒĆ¹]‡e68‰¶Ś A(+§xŒ eŁ™XÖĪ30aÉģēb-†Vƒ/i*¼P¢5ó[…čł”Ą–ļ‹Īvc—R(ęKć?r° £ļ\Ұ£ī¤× Ą×“Z^ö{MFNŸ«ˆ¦CĘĢljŠé(į ćD•‡»@t­° ÷ķĖČĖÖhŌ• [’!ÄėløjūčŪö¹ÖZœ”­Y”,^†,„™dV¦ė3fYHõ(æīŒ4PD“a½/E;æŲ†Z¤`€¤ŽtļŹ¢[õéŚŃ‡-®nn÷1wŗā0ŒZǁ 4>²“/^©ę¼Yi_ŅVh“ :čĀ4”Źų/½Ą¼lńåO'Ļń”ƎĶh€œ„HYgĻÜ#J‡P—˜2|į·ˆųXGÄSŁÓAzi= s·ųĄCŌŅ“ÕžS>”Ī÷UĀį hCŻš0~sÖcõW& eęøišģ=Ś÷n2 ųD@‰ŃąńUĀ;‘2Ā*`hŌwBzŃ>S'Ģs9R”=ä×`–.ņžŽ ė-”'Ņ1lž6ü™6e‡÷ĆȽ‘TBˆ …Ļ4ļŃS÷ōSIՐ.˜ĢhŸĪ7¢!Ē‘c€”æ¬S¤—0ō””l§T¾£ņĀOؤ­Ō¬QĄv¢—ÉābłUŁ!KbīčĢn«ß¦¹+1’5—Qū¶"[V;®˜)ž‚Üć²xļ`$)<Wœ1֊“#€.×IŚ“bÓa8!\M&M:ņHHźqŃ%`!āšZMÓ²ńń3vłņĖŹŌ”ķĖŪ®)«lRĪž<“‘^VšH‘H»dš±†Ću…ąM\M­ųu ›źĻ¬žįIó×P2䩱|“z”żu‡.ś?J)Qųω(7źĒ;‘Ō–Ow°ŒžŠŽJ*Īņ”ūéb+¢ŁĖćm)ŁcbzäÉ“ŲR"ś¬óüŲ(žžct©ńÆņ$ęŅÅ!§ß'§A&£ß&ņ£™BXƒ.”ƒŖG”fēkOm0Bõ&’į!e¤ĀžJęūą3Ź8(Š)uĘŃY]Ä"?µ6J!”ņ¼*ö©%dĪW\CŻ­ŗzE½:÷®Ih ߀-m}š13$įӂ¶ū!sGų0ѳ]ųI‘ūN3]D,]ų†g–Ģ»~lńŖ—©f³?os–dw3źB!;™ §EQ1v‘|”gś¾AG Ļx >‰,m¤Õķø²į­•/Ļõ•ä®;½£G_˜_ė&H““ŽĘ)`xvPĖį?ˆšjö¶4ąŠóŲ[da˜7‹Ł|ƒŖ”5ŗ\Jqs[KŸ† sR'œ>ģ̆%”°½¾ų#6<įVš¢—Œęńy–}`nł•ÆŻ%ĆYUHē.ž! ˆ›žOč gėj—×ó ģÜp#É4>[ĆąŲE–¤–¤Ŗóh‘Š!4D 8fNĄłČ—Xvo‚NpH*B ģwȏŚķue wčēŗT¬ōOp¦=üčR%ŒZŠ Ž•J&ó`DtŖ&{vØ3¤øÄ7"ģŽć¦†aĖŠ –āO6ĮÅłN4nęOž¬‚ķųļ58s²!ø%? 8ōē–ĒāPŻ1væėŪĒ^ŚÆU©Ī‚_ŪJU9lķ4?:ķ˜ridn#])VĀį*‡Xä꫹ęó¹„oöė4±­ć\$Ęą bVTA~źŻˆTn~«„R¦^»(šxŲģ$ŠJüa«åµ™ż3 Ē…kō³u ʚ{Cgߝ“±Š”jӔXMp/<^ĆÕøĻ›zGꑧzf1ĀѧЉ·łKī7ˆļ®¶Ķß}ŻĮź”Xšvó™^€Ałˆžė0Ńõ…ę”d(JĢņ”lüķPY£=„Ü?ƒn«J5q„•—z6§v7čĄŅY#‰k;Yüā3ūŽōpMŅ c#·ŪĪwśŸśĘõ.č­Ņą‰O5Ŗ$*źj-,ó0_ėÉ ŻĻ­~$–ōbæb0‰¼ī«s8(Ü^¹ŻHHŸgŪrĄjā&3ā}ŹźģĆäŲ*‡Üī'®J‚ÅŌtܒA«¾é"SC}G®Ķ§Ä#­«1b­”5iL†"ćĖqž7E>{ jPA²αģ\ž³…æ`³Øļ΃nrŀ?āō™³¼é«jOóĪ­Ģ+ć„»Ó¶!¶eĀöh¢ˆf‹.ųż•0Ü$³Ųļė=ņLī§^›W†@äŪņv¼œīē>‹Z°§„Bģ€[Lbˆć;FK[ØOŽl6ģKŸ °j–ĒĮ;:™>Ź(¾ˆ‡nåÄĪ®DŹŽƒmč*Ī#±xZHeµ²ŽŲ÷„N#CüŃ©-1R{¢N“`ņgåH޶c†˜½_ā7›ś‚wÄZ~9"=Q€ ›ičf|mäŗžC捊›—-É)dĮ€”aOēpvh§C0sFf§¼É mg®¦dQR˜õÆw‰ßõ½ż1ōŒć«£Ęö<‚ b䤹X’}čå-źJ« łRÆEəp'¶'¬«”­Éó0ÉaҤšqY<\8E¹ķü’–Cs5ĆOFʈ¼½“d:=ĒÕ”mŻLŸéƒ)jųm5e·ĆąŠŚŁśĀH¾¬²Ž]å³2šŻ­—8µm D ɳ‹rćū°ł±=Ą¼ćæĘ€ųpźčeęŠé X©!ōū“ņ‹ä `QZą10’āBĒ2L€Ņ•O”ķ,O~ś}jöans)°ŚųłµÓ×KŽęā2åŖ’ŚŻʙ÷Vߏ“j†n"TŠ“­ˆŻ›‡RĘĒŲ斐Õķ@¦ą³Ļ&r@HrŚč·9 gEī¦å™N„4˜ŲkśÕæįą×N‹°Šśś²§Ź‘EššéŽĪ&¾śĶ©b!±T…Ć*¶Ü’ŽØV÷.˜­zKE³ö¢2µŌ?¶ü©¬‹Õ×G/ŖŠįN¬<Ä)ŒŲ£ī£ŲLŲė) T 3ÖĘ®Rå”ņ u§OIB·!Š»oĀ+Œ•ž°‡YüÆßē’=a™}E¤œūyéŒ6Ąäż«ž÷#Ox¢‚ĘY¦ˆøį+¼†7ŅĮŠŠ$gOZžĘ•X?ÕĀ„ķ5ErnĻ{G½Ķ’¾!Ā©†'‰©^Ļ€Īg…UĪ>ŹW·Ē)ޟŽ›³¼øqĒ:¼Ģf3nA ŽŽ²³B"šŖķ8Wl$Ą#ŠēŽźĶ‡{ĒĄŖ‘Uņ:K|łöbģS[dpēX¼r· D`Ŗä#”ō\³™WŒé-ķl 0ńT@- Ļå†GAwŃæ8ŽNČ+ėŚĒx«ņkk7ģ†äžš™īŲŠŠĻ;1½ŻŹ}Ÿ5»b¹*Æ<‚ć·uÜ!ŖÄē™Ag ÷^Zäāj˜—ÉQˆ$į(Ł{ Ŗ€a3Fj’Įoļdчn7ˆ]ŒÉMi«ō“õĆ ~Z ųpéŅDß§Ž \ Ė÷å= %§öm¦¤hbŲ|rĒ﻽‰ŒóUōā·Żģ2ŚÄf{ɬłżÉ mu†˜½įkŠ×Ņ椽ĶY‡1ł_”F2žŻ üC!ļHĢči…U[åAe×ԁ2ė įy,%2Ū™˜'®ō‘\)iW^TūÉX^%½jjZņՖ:Ųo˜†ź"0rŖIūDé÷VąWŁhYUxēƒŁ¢Ņōī ,b<ƌļ\=ēźķw/ä:.Į%”ŠņĶ“¦t¾¾O½?Vo¤5N7 >b¹H©Ž{› ’wBµ46ŽfŹU “}ņ¶ż|š<’ +ėĒ5'Bž˜1ų–ålP“Ć“F„mJØoމø²x2š4fP•KP'Ć=ė™ĮZąn]ńe³ąK Ģ)ņ4 lÆ”ń©ęq³}v@b­IĮ¤ ”˜§ĀCžįe@3ŌÓQ °j–öœYˆSoÉr$ra©¶rž@õ6&晑ū.¤[.T Q’}BĮaK²¼elBöT€j³ś8„Ć>"ʁ™]’ośČ@4ę3!)¶ŪY'¤ōk‚ŲX„˜Įlü‰ó• åC.ŽhüĮcW‡JļŹk:ŽŠw¬˜jLę7韈ždL>޳QīPrtŗĮvą“#ÅLµEY&/ߚÜ{V‰ą€cOŠ~i:\ߥÕĮį†SéĶäĒĻ–ogf!½š'y%草oeW2 ~ųD­eŪ;„įlÜ噼3`ŻŽŁ:–« ćÜ,N ńšƒ1żÜ{%O“Š Ń~wuSóĶ8üōߓԻdēŹĘŽŗšć'¦ŃźŖõū tæķćÆą&ąD;ÜISdØ$C6śA¾¼ĻŁż ¼ÕŽ6U®T _(ˆØÅ«éP¶5³Žęwü­ŒµC4¹æ¾’ŁŖCOJfL®ķõøo!ß eģK/’öõ.¦‘ķ?=į"P}Źń\“ię ź•Ż<Ć'ļ“1įŻóĮˆi1Ą~b<¬4- ÅaglaO¾“ߦ8ÅøwA,‚Ė'kĒoʬśęÅČJ&$æż”yõ' äuĒĪ&Ņ\0—?z¢K\å·ēɐÖŲĮīŁŪń‘Rßd k¦ +P[VćĀUw¼öW”ŗmAėŪ؜^Š[¢41“§ }{käi>+atÄć6Z3!M|ŅæuĄBEG+™ĘĢH&P28÷sš¢š¹­‘·^Ž$MĘf¢”¾‚ņ~ūjOū ß“¹Ķėȁ0[üEž)Æ,Č)ʵ;©±sŽżā­z&‹äŃIoŽ3†’CJž‰Rg=ĄÄ0rķ‹2Üc\<ŽŸ³'\»ŹuĀŃs’,„ĘKjóĆŪ—ķ§ėĖ^ųJ™e“Z;`,m)ōń °ĖNÉ.śbč;0]žüÕžé#" = 0²å%7ˆå"j°†H?'"Cɇns½~Ū6‡³Į÷no…P Ž«1ńi¬døc¬Ė1„EMÉIf§Śś”čш ’QQ‡æhy,@Px€ųļó=6ƒHÄ·qŠsœąb‡fš]‹Œ“ĘÄѼžŽĘüCm:čŪĖduBłe‚LÅæÜڶ²”ķ–mē&ŻĢqģ®ō•YÜ•}€mtšŒźA”Ū°ƒ®,ŪAƝłČāAg]NŌU*b‚_·tqńjw>ż~JąbŞųėq ¦™|Ūjóė$²ņŒ¬±v„’7“ؔ„;õ!ˆaŅ(ßĻ*rY ($ Üł8­ėVFįķŖIC_>Y¤Ļxńyƒšæćķ]OL¶Ž¹q£¤Ucz–Š#]9%—žhs™­!¼ŌŹH—PEõ‚HÕdS¶Ņ¤43~‹ļ"Åō&]¾µ¬ÆžīŽ | ©_Ž4#…»æ®1ʝ»37“õŠ£ÄF„kš%>¶xš›ØÜŠ^ČBµŌø’QLß`u–] ŃCŪžoy’÷‰8‡ūϱ#”]²r*å¤T_³[#šė "ł?|‹‹[¾Ryh³hqßÜż. ĪćYćńżŁl9eÜH©ęH‡ĄJĖōżXd‰pā™Vį~+č›ĆĀĄ®äŸÉĶrĻ!R‹o ·łkŅ„ĄŹs3­õ™ ÕŠBqęv}²o’MŸm8€U(dńķ1é|Łc½ŗƒVę|H‚l|cėZyŻ<3œ9%Q0ūµĖR–,` ֛˜‚łe•åļ’Ø9½eL5n=N^¦±A'”yƒØJ«_L™ški—Gŷ㜩Ņ1ķ;gŖī¼ßké:&nƬ£¢Gw$–ß² vŒp"y».Y†'ŗNčI_ÜV, ®ŒŗĪ\BØ¢ö~RLż“D­  gCƒ ,HśLyåŲ&ł/Ķ%³»X{Įø.Č0×iJ%Y])*[¶8¼µ@ŅšĒåQ“Q—QI€t…øżīŅAČœXń ©Ō†œ5Ś®Œ>ē—Śj>ō6ĒΘk]ŚźžZØäÖ¼µt31@ä4ß:üĮ³ś¤;zÜ?Ž8LI7…d®“Œ·!hKž…ā~ķÆŅö`© bę4tf†śŠ®ś§>¼śæ,4ҾІ¹Å2…mG’ĢźāsҚ„ćåÕ(Ų~ȤōV(„uér—ŃĄl#r9}ĘūxzżŲēoóOŠ™ ę2ķ‘;g.Ŗ¾’…]k;vį³:Ø\ § Y{ ™|µ®āė““÷@pØld6šR‚4«’lķūµæ\öžØoµj™*čńz±LŽŲ¤Džõ5q1e:ÄÄpŹg!&³M™B]I—A{@éEĶįs Xš›DEŔd֝įBfI*µ'dĒIøģ~©P’žqNöE÷³Õ#öćpŠ5hÕ£»²Ÿ©l÷4Ń)=‹ß\ M@ƒ:NŽ‹CĪķ¹P’Ę¢™Z8ū„Šx9ųōōµž¹rs<{į:ӌ“H'ƒ ÖsVr>žŖ ¬łmxĀepecć6›ÓZˆ ‘$ˆw­œĄ·BüĶˆ ¼j”–ą€‰Ū ?šY;1ž:l%ś`½ÜOŠ ;[ -źōå P’tC§ŌBY%•ĪK6Č+OӵܺœühMPŽ ÅTšŁ¹’V­LŗŻ¼•±Ÿ×/‰ē+iD¤üŖ €ÉéÕƒ ‰öÕŌyšPĶ1™©·9± Ÿłˆ,"¶u Č„ŸUm•Q"k"|ÄNŹ5Åa£[9–£Č#$ĻcsJ©c¶ NB³n6šõ¶MžKĪ?¤l$tĪ`)nlwU{u0[¼Ź«ü…—~ś9䍦PpńśĄV{K¤µ…®4/ &”ĒńĆį]¤Ro®wzßÖPĮlŲ†^ģż‘p[1%ŗõX0•O3WŪ9!Āņ@pŚČ\Ųó0mÓͶż±ŸĆœeķČz¾RCń˜Fß”Wł‘Q‚(ƒ0x;I³¶§C“ż+.ok$4Ė45„ĮŚ›óÖ)yšżWįŚæMÅä +7)®V?’fO«Wųå€Āßl^PĄ<óÆ3xÉ õ„0 ›Ģ‘×ĶŁšĢXI"9Cw^/Ÿ~™n8F~˜¢ĒĄž{·ģ„®GK_R¾6źÅoqõ—éHŸ-¢7­/^/gcg yVžFVŌĮ ż7oatIėčHF©.²äž‘mUxē ć Óųėj b…ć‡)%ż«G[ÉkęŠg˟uķx½­ĖW“üˆ‘z©ÕMŽ.µ’ŗ<¾TõŃ`Ü-\Ā­Wč¾[‹ż„Šõ3}jõUæ”ć)ėńņx1aµ©ź`MžeɹĄYźūóšā•oš l=Ž=­‚ŚÄ/ŗY®S ¤Ŗē»v€¹Kߘ-Ę v„üvtM Ś(Ķõūą8’fćgŽkQHŠHj° )³Y]OJ«šŸį±<[ČlØcc%Į E bŠ#ÅxĒ/;8Tlž_Śč\aÜPH³‘–Ƭ;†~}uūĉ¹°m„ŗ"6O{M Sæ<2CŲŠ9m”IÉĒ> ¬^µG°HōS~KŠFž¹¾2}£<éėIu‹!4įŚŅ^qĖY1h¾Ü«fzˆõ”¦‰L¹£oƝqNKéIp”Ź€Üq”rą —0sŒjąQT’‰…Šõ.fķ|±÷F¬娐ZyĄņ8ēŠ·µvU­.ϲCDjéÓÆł½zßŌ^ą‚;ž8§ez@ߟIc¼\ßH8„Ѭm×; Fėšó1ZF¼%„wĖ]'¾ ˜RØA™t|!4צˆB’‰{aį®#©4v±¾’; w"g$ŗ²†Ėž ,×Dfī>)ŗ{k>ÓįÕ4A$n’½’#õ`āŠĢ/²RäłģéH1ģ­nƒµüžhŲj(y5›³Ģ{¤Ń8nՍéŠ-Ću³¾%Ä y4\¢_-˜68*įĪ{Ā%ŸM¾Ēģ īD³[ŽeĖōž0\Śæõ[čĒ<Ķļ°c2&2¼=‰øXm­'ļŅSh>Ź,{6ķå»DtŅø“ś-dT˜&„$Cŗ‰ž‰ąŌ𨐓}|ÓGŪ]1b'ą‘VW¤¶ü¤£VŲ¶ļ¤Ö½+(ÓÉtžŚ8FeXµŁk²%–ārż ø*²q‡YT|Uį »°)’ŁŠ<ŅķJÆš3;Ż,nTkXų“,w]ĶGĘ)`UĀųń(ų“Œ½Ņ¼xė&E/gT&< ĘAĪÖwĆZ xRĆóop‘&Ń—Óµ‰Sh‘œ::9?9‰eڹÖŅ0,BØ“š0fœŌÖ3 7—ƆYge2å¬ qløÉŗšIŪŚ31Åłõ~_;Vb>±3*Ķū•Ā+¤¬Œ-“gĄńY,œ9hŸ>ŚāŖ^TśŲ¬¾Uō\¼:āŻó>¼Łū2ĆGIļ9ˆ½|摗}…p‰>THŲ=)e Z!Gǣ߀8v|¤%¼)Ɓē~гuځ’’ £ŽŅņ©lGī„f 88ĢDÆõŽĢ/`LzJ…b³ĶŖ[MĻ.?÷īZģRMGįfmņ›Ö©ņ£a;`9¾P„wĘģē†Nn©øWČķ(é{åL¦”z0qAORźx;B¹qEI”Œ7+ˆl‡>»(+«“}ųžś€c÷ؐØvŹŅ3ćŖøŅWØK¼uŌ0i­½F/ę[ą“īńhöīLŗ,žŪÆĘōĪĢšG;̐×_L”­”æ>T²d}&7hÉNļb¬¤Ć/¹šīņ)Yb½„,TÄt ?äĀę}ĄõG˜1d­ŌĶ;I hQLµąŽCAŚ­¢S @ ėlĖ(W¬  K{1Kp¹”0q]wāē x~…čŹ˜Æ’[Ą&5īx¶<%G«(|GWŠGȂ šŅ# €īźŁ’ĪÆś”ś’d×µ%D鏤ĪÉNS¦ƒ“»³čųyaŅĒWØŁ€ L¼ˆŠżTž1·®0zݽ—ČīĘÜśżķ˜{žēkģ!-$4™gīĆ1õab˜I ł@$YR(ŒŠj¼w\K}§©›ėjn¼K„ĆäaĢX=žølŽ¢m…€z†ĄłdžĪQq`„| <Üė0K•÷ …Ėčb?ÖćCO”BD‘ČčŽ <*Äø±5*īŪvø°éč£č­@$e08Ąšcv%`oŚKbßl:ÕäĆIČEYш„H“įrQ+ōišR—.¤ęK #…›foICozg?ŖļŖI9œ0¤&ube(ōƒ»»8L —s -7HV(Ę}7°łą¬éĘ D?ܜ>5šß’Ä+Ö­, J×ČŠ(|ėõ=ō'lē­‚$ATA°Œ,Ÿė±¾ tŲfx YkŚ{6k|Ē@yŖ ƂL Z=@ōy,šÕ•{š@uäVo †“j’—…Ī®±ą^ĢõwXb@ „vX_rŅĀ'ŖŲYvfSTŠø°ÜŃd£Jäų®‡åo÷ķŅX"?÷oēĘHPNĮn3§KŅLŁ ¼ŌeģCźķ)^‚LK»šē6­us}-ˆ|°5œ7ģŻĶ½éžFØÅ)oŚ®įÄēƒŠM±(Ų«Ąö`ˆxļĘ!8 Źh|E‚ŠŅ#X,ĮĶĢjJ¤\ zOX¹šļfēK~pĢÕbmcYIVŌĪ[č$ą‘/ ];b…¾įæčGiĶ õؑŠrōźe)œÆ„½Ø·ä“u‚­&07ūӀM'¬·Ŗņīģ‹ Ū£Gßæ(XģJ$ćmj\ Īr6ä z ͶoØŒĪ 1ÆĻBAŁPµš!Ŗ“nBsɱ•¬i[»TF_7Źī92\ŲO%iŻŁß“=j¹°®=e!Ģs„ <ŚģFŠž¹ óbĻČĀXæōōSU‚Ė:By¤sZ-ØEÖĦSōņBēŽžG=o%į2£Ńāć¾|¢æņ]¦ƒc;>,#.Ī(ĒéŒ3Z‡ąvP­r/SµSdkgO&ÉÉ‹ĶUņĪG/Ē]L{ĖŠÕŃ£…Ā{.E‚›ÅVR‡¢Ņ¹„&Ŗ5-lµ“ZN—d‹=T2Ū&MG˜¾Ŗ:p ŽÖVö…!“2IÓ2Żč‡įļ’r?8Q{ō—õ×Ų?+–Ó‡q%švžś7iˆÅ&4H­;Sś[`a÷õ#‰+É5Nrާ;a1ŽmłnŃś—BÉŽ‘[•ėų彄z‰ŁKP ē“ÉoۘBØį(Š_’®JvēŠp…‚f3oŸÉ`ówĶ ™ŖNÓ1­|Ŗba‹C²’Y—Pļ™Ł)‚œn Qr×-įBG':x7}6V/ś DF ū|ŖU`ģ9pĒžBŗµį6ĪæÆšMUšńßNü‚ó NpŗøźŠ×ä»×py аœ ·‡Ź-½ßQw hCżMėÕw3u×Ó»yšĪ9ß÷Ä|Ōhrm¤zĀ5µė-u˜jv¹[įūņ[k ÷½@¦™~}–łUŻ]ĄIžżUū¦õ€åÉfWqƒœ•nŚjŠ].2 ˜N Q(Īi"ąŹtµŠ^«Ŗ?§\Ž?5·¼ 6 DČėFĶa:¼\0ާkmŹaC SP5šæš8: ÉĻÜy+ӍYJy}¢>"·`Ŗ°É¶w›6»7@Ü_ׇ««ń[³yX}E+SĆh`–›Ģgņ!±#¦½­•ąFšØÄüæ;¼?¤Õš’ FTķTe#]§·ąQµėėWtЉõ{kµ÷}”Žņb§ˆmōהEÖYæĘ— ¾U÷®cä’S©>ŃMqÄżļXĪė¦)’Ų–~³Ö‰mVóU¼Å¶ätėÖųOs\»)œčķT@)§Łqį(÷K¢ z#žŗu‡gåĖ7Ķæ^8š`C±™.ƒ†doÓģĘėæ6ō«7a)Ō¹œøE%žu2FÓߊłQųõŠā`äŖb‹=ß”X> $„ś²8ä’øČc³‹ßr²…™¤ä`Dœ¶²1…ķÉ™cZ…-æhå½ĖZ‘*AœQ ¤{^ŅöGuŗ-5X½4ģÅ® —)ąż¦T§|ŖRA£¦¤ž1 [< C±ÆdćH§‡œŚdT!PńƒŽģf&sNj•T>šĻ0l)ā8ōįOø>a ŗ%ž™;Īį¢ī<“(ź>Tų&2 Ģf(Źļä®vOPėŁwŠ y·P$9ŃfźŽóÖllYé{Ö`šŽP·ÕżœEåoCih·»‹g}ݘ/=£ČTžXæ±A~±ĄĒf̓&ĖtE4ĆÖ;Ą6ą ĆQŸˆ„»ļĪcN}ńė9^åF6 ĒŌ(EšįŖ#§‘Q}Ć »/%x/¶‡cg¤ŌU=.UĻęŻ%g—>÷±Śj§|źMĘUr1N’®vx’~, –Ņ@j«u¾ŗ|‚j hc…õĘķ ȉü#BGf°+9MŲ§’/zė‚!Gw–vgBUŽ*yĪN.Žį·2tœCØJWP?(É£ēĆćk„3љč†Z›ŃsŚ0»’)ÖJvį+Q' āź1m«X†N„”ZŽ[nö”Ł“xwŽÓ]¹©:j«…‚¶IA[Ū7׎:oŗ»ŠN6ŪT×u5ń{éĪĖKpī=¶BVģœßxQkBq”bO{į‘ t|؋廹ūR¦Ćż™Ę)å³lŖŲE¢±:Å ¬btÆcņE'MxąUóNÅ„ÓC°Åzć쨉įhF-š‹ 5ic™@›žS'/\Ž©ŌKi ‰Tŗąś†§ßŖ=ŒŠĢåÖ"ŗÆÓōt…Æ„+xõ§ßlÅø^,Lb ķEBø`›į¤:Žžp5bP]šyxł‚ĄBZØNɽ±Efx'ŅhŃ…KLMŠņ­f“Fµ‰#¤CmäšßD=S1hTźU€§Ģ’“8 ēšv_0˜[ Įū%{Wģx«dW—^UfßZ³LŁ,õ&6ę x÷q4H\ŻEÆ.ÉĀE­£ØædA@Œ§gÜDpß4"Æ/bIUVź&żŹŸ€ŸónWCf…ĘķąÕÄ0®æsŲVüJõīŲ]b'i%ķņTp)‡»£?– :¶KøžPć­@()0­tAåķ?sr֘IJęxBQåéyˆ_H `Ś. B3h ¬ż –cźŃ°>© ÅzwŖĻī™&?ö\'Ņ‚‡’xń}4łŚŁžkZq¼[icĶ܉éZ‹K÷ķ…"ķŽ8ĶŹÕń)ąĆŠH7tķŽB(ąDµ6¬…®=K~‹&ß­ĖSĪź€=¦.!¾`}Z²94Y'<ÖŚÕÅf]P„ćߥ2˰’9_½ęž7UDg@ަBÖ° W4ņaRNM”5iՕ7ĻzŅ7Œs¦3G"Xp~Ī66‹]Ą\ag™•Du #en¶v¬Ńu½Ö堏ø»ct˜ĀŠgŗĖĪ“AˆnP²ŚWćH€®½y[ń÷`†ų9ֹƻ8 ų9äĢz~ēķG’šõ{ÄÖüzŃ*µŻĄ±ErĒ«hī_¢½-čQ~:F||Š ¶¼•ŹöŽ ”õŒ„‘łÓ,5Ų)Xķøo8ó³NO«ų™ąyv{c÷›[’µL|¹ńĢāzŸé÷†˜ž.Ģn.éÜ3–‰]عK󅩳GV„Ÿ…ŃW G˜µ{Ą!%AjŽ)nījø°JCA !8IK»žSś"ü`9ŪŲÜ<_n^µY.¦€łęõĮ~ õ@ŒsĶšw Ȓ®vū†ykŌ,›½pżKQßj«Ē5¹””ݵӂ„=I“`šßéäŠWNJdć ½ł4«š’‘‹>÷ dsą:Ū¹Mvw‰CŻJHž†„ ¢Y%A?$N'ž'•ü”άy§”©æ”dkźÄ8’JįQ2e²ŁĶh;žŸ™\œbļә_AŁįŻ‚`pό9ŖOµ%ēNbf»oŖ‚ÅŒöŪyQĘc±Y–ióŹēš¼»īŽW ²ušŪ}Yŗ£¦ß$<Ŗ¼#ęĒ„HŪĶ•”L̛܄ˆ^]Ÿ—·UjČ^¤čš˜Ą6W9įų!¢·ńØ$Õlō…éāæ,œ_1rū5YÜ.¬]7”„æ—s[­éĻō3:LNŲi3K fŖÄWų$ĄkQ©ƒ“m RšYčI`‡u Ąé®‹3C{o&l+#‚Ґ5rŅüˆÄ'„įŠr·Z2vń³üŖ‡{4ŁóÕi³Õ~Ėž”h7ĶėVēY_äó`Œ”——ż‹Z®¶ĀłŠč ŒHuŽH6‡ĶK$®Ųaњs£$Ē™€å”;Y·=A $Źō§{°¶ź`}³—qW7$eŗĆ…®ÄĻŃ*‘Έtņf En“©ŠB~|ŗ»–‚šōø¬ˆC&VČrÆäŗ÷d`ł¼ń[¾4’¦rĘ×UQц )ōøšä8P9IķjčśķļŹ?ć^W÷tĖFµjA›ķĢdÖå9Ķz¼Iš«87ž¶jōžĘó—Ļ9GuŠŗVUA­#6Ozd˜Ž|JŸČ*=źĒĖ#?"Ę`č%h„S>Œ„{ĘßVÖF¼ˆŠ×†“†.Ņk^Œ%7߃ļažĢ.©>ÓĖŅ™éŅā¶‡»®›ļs†?t`iåʃRqmĮd§ŠĒr{=†ö/į*Ų ćŲv+žģx“¬æšŅg|JŅÆ¼ŗ^ye&PĒ5½µĀ÷f8…!łą†t_d3{„ßö£ī®/¤AUĀæSpö¢Ž2}¹Æåė˜NefIź×?Ł9PĶīņkō«¼Of%‚’ĢĢg@Z—’‡v¦<³|½µ  ¤” ÆĄŅOŻõńĆ`ADwāœFßgcӒ–¼–¤ā<+é§;PŠęفå~µi°²/= 5MF4]=ĘĄqĒ„Ćõ~ĻČ&ž ”üؙ—–ŸÆ~}؀¤é¾s­kć+NÖ^œ]ĻŹ®—J;%×°l Af4`„„|ĄFU°Œ+ŠXl¼ƒ ŒD5?žG†g8L4:ģ.—Cń’Ż^Ŗ©Øyo GwķesēĆ-љ±L«į•Õx¢‰ ŠäŖ)³Åy/¦¢øhŽŗœÉVŃ_ŹŁąg86q‚JäŌóY ,ø÷“§]S‘S”eŹ22c”¾±źŽœÖÄF«ŠÆ•IFUš Ļžm²\Ó½ĪĢm’MJrS [VU‚šŖÓW¹gŖ*wĻ·āMrń$²”­[Oń“¼ßąWO*`¾„kA cW^ūž³ Ž}&Ķ]F»ĄŠb*(V8'…£\£žļźvŹ3_4‡8¬üēŖOWhēģŽ-‡\R.ń×~MƒĄ ŹŃ8‹5(Ŗ×£ĮĄ/ź²™gC ²~j»sq q>!‰ł‰En •,’Uŗ%Ņ»ń$ Öܔ@<£Ę¬ģ9‚Ø%G§÷dĶščĒÉFĆŁ»üƒHß,®m`­ĘŃ!čRSzc~ˆŁ)ō|:÷š7f|zEŸŲæ0r8­¦ÜMģR(5˜Zų””=xƉ”PÄT3ÖļŠÖé©¢ņ=D¼_¶½PÕ橈FęŪłĆ܇0ŗä©‰*ŁnĒ“ĆÅ8‚SEŒ‹ńjŽó½ššƒkFcąd|Źjß΃5¦d •_<`ųČ!ƹP “½•H$¼ÄĪI³`0x¢āĀ9Ö.4I~™O^ˆ FbP¢;ĒΊ•UcCQξñBŹkėVĢåį0ż…݉B½u·HaMtŒVÕ>mŸźäTŠ©¤“xšq9IŌPa×y¬˜_ģEšõĖFC¤O  \Mܞī;šÖœ‘ewq^»Ü)ŗ"Ā]­7¾źåŽHQĒTŸ:°ĖįĀZ¦Q§{s=«ąƒF( jĪŁµQQį~' eĀĄæŁ…EGĮßp\×_x ««Ā’ņR\½łG|`44™č`‚†®Ļ=īU›Ü$īV#“¬W›—įĻuXš lpļ?ę0N0õ–µŠk]#ńBøkĘs) ©‰™3łźš·R’‚5ķw„‹ĻüJ%Ą‚£s)īF¼*Š ēą3 /0NmĀTW •«†™4p@?‰•.K")č‘z‹wMę7ŽCiŽŪ×>³“ .ŒŲtÆшXeĘØi9œ˜:c^ŠĮæyy–˜AA2,pĶ06f!(ē7£ä~«E±”õr÷%Ÿj ö|×™ŁšĶßĶ|ŌŽżuźwu¹œÉ„2¢Ņ]¼½˜CTņ”ŅŻ„ ļ3H»ö—{"kN¤ż]?HŒØŽ›mĢõY5±"01Ķü;žū‡rSʾˆßׄ5–tzŹQ²Ą\U5ī”Į!G,øG6‹3’‰g Xpe,“jUĒ”µvlöø…L™‰BēóŌUčÓųsŲ—A¾y1r‹eė&ēœ æmHŽ~V©QDMe"}ŃĖʗNSŖ_dµµA“.CŽÜœø ¤-_†%h—ķ&#Ķ@"ŸÉõl†tUÕ$łōoÕ&±“WģĮ¤R欗Ą'T{Ė*09f×ņŒŲ B,˜X¼vŒĢĒ@A“ĖõĻÆ?]¤Æ‡#®åm)\›…rć-VU4„/]#C†ĢŻMā ,5;ANģ’ųņZ¤X)ߏ§*Ŗ£¼JļōOé¬įõėµń²~ā]Ņš‡~/³oeĪUgĄØgE^W Ą¬Q¬øą F¦³ &ņ+϶+3Ŷ N S¼€2?P’ž"ĪÆŻ8s9 8€ øÄż ĄŌ{īļ€=4÷šŹ·ŽG­°­OusC48ڈa&(ó}ŹžŸZnŪ·½VžņßZ"۟¦æü1•ŁV²‚ż“ž08€ŹSĀ{|°ey捡ĶĖ®€§{ÖŠÖ«˜:(^!÷ž‰’łśBĀр…śwY“1©HčģźUÓc…ĆŪwžV@ŻåGņ_Ŗ]$Õcga‘ĆŽ~ĶcnGuŸømĻōy±ąå†m‰+§ @iń8“±Ć–ī¶ņ^2}I­ŲŽĻ¢ė嫍ŖÅĻéĮÄhŌ4į†¦oD˟‡†bźÕ°¤ŚBŪ=ó!ō2ä½>Wœē£!•‚ˆh;eZØŒ ‘ŗ°Šg¼$­}żEIóŅiŅߣIĮ®"äĒĶ›I*Ą¤³¾&…Wõć”cāEžaˆ|Ā µzrzēb7*|Ó{˜śPŲhż}ĒŌłTś‰'÷7še¹óYtnīńųŪlĘ04I·:ŌŽ¦v@uTmĢX…ŃŽ=!5j•D«m™’HŃ/j„%w»šqGł±'ƒ ¹ėhC’j„ŗEõF³™tlŌ~>lf(ń»f¹č ĄdÄĘŌõŚ{[¬Ōŗ,Š…+Auµ…õļąŸ×N@ąHlrrŲ!Ū+}fGY€åŲČĒ“K˜» nSĄĪ\ Ż*¤`| *¬Ļ;~Sėåg†c÷ą9ŽjnŁ7æ×ė(„8Ōø¾JŽ`Ėļ^9ž…‘F§'«yž¾?,@l!× …~‘?’‹€/¹h…m“ču^¦«3£ĀŅ+qG\£ƒ-V ó;"ŗr³ߏė(ftŌgÅØT–Ag‡^f¶‘¶įØ¾Ė¹G0ųäŹ:dėTtHĢ"-ż©ĶGcœž>a"ŅN›— )—ŽN½ź3›Š…M×÷pØW Įy6ĮIbÓ¼€;n7Ėä2ȵͰ¾‚ĪŖ(/Z6 *!Ä ā_6ƃ+ ę”[]}eÅķløå°Œįih”x‹öNąz’čģó’IĄę! ČdeœxC7‡^ƒ>°'„p‘o’™"ę9Œ$BōóN<>wT6¾H\L›W™a¬p̼ƒF¼"RGž*tQžļ‡Bę÷a{±©š«]ȬŠŻ„įļ”>ÜīÕ_õPāŻ:Qͦ2c–Ŗā]=č³-ō0Ÿi*få—kXgWęb" Č_9IJŒ¹>ĊšK8jQmš³6j–æ°5[‰ —NÉŪ¼ĻHyy§]²/Źćą$ć{s?Ź-Ŗˆäh~Éī\°y2^+ē<‰|\²ÓFŃ%nžŖ»¤y(tļŗøĀdŒ‘ąĄĪ:ŒįÅ„¾–įüūÕžo-Ļ÷Ƀüq’Ś"/7°.¶u8„&©æŲņƲ oļDgłOъ£dKŲž#ø5’ćec’ź%p5›`Ŗ[XŁĪ B‡xV ņź,‘ ŲTćłķ§W, ‚hž™CMžÖŗ‡BBĒčŹlÄuLpš4żTW½’}ū_Ńß³ć§[P…Nä9x¾į„×'±L$‰ņrÕxȃ+ŻbinŠi’-EŻ«–, l ÕÅÅ2łh5²ķ3+˜y`́­JwŖõµårłĆ;¦¼ą5²ÜR Ÿ Ķ–RĢ"§e³W"ŪŠŹķļMCłźDuy“]žjr3X”–»1!EčTōżŽ1eÆ}Š>j”iRę”V„JĆņF^ ž XzŚōsŠ.©2•ĻøÓ KO«Cg³z٤•+j{„ Ō‘OGĄžęßŗEnŹ\D‹¼Ō?oZPŒDbI—0T6rÖ +Õ*<ĶœŲ`'°šµRčm SbĮ|AsJ®±L¤¤¾¶ęŠ7ϳ·¬Ņ$!/!µ{‰øCCŠ>¹eķ Ī*—ˆMŅhĮhź†aéV£«„ِٖRgńņĮ•ą‘÷<ńō Ć¼4ķ3ƾRųpV¾>\ž}¶\¤¤§šg6×v/Ņ _1Ž@‡ź‚špP€¶JEOŸ5—[Vż°æ·öŃ«.s’ØŚōź£Ķ÷%{ĒŪpĄy˜ČTT«3‘JŠW퓬Ķ×ø"‘¶§4āʘ<;(,%ōSĮbĢŽSXLbźQĢ7m@}©W)¼īØ =¦“°V,žźtIo %ųń@ fŻ0^lDŌe±ĪW³IžA懒Ēįx<(ƙWw\:–X•Q6·`G±Ć€µĖ&Rmu+ģĪ‚Ėę˜ĆIņŅIģd4U2 G@J¦·ĢūćįæRI+ķQ±cÕĪŲmé,"sj®ßu2gćzų€“é ŖO×ģö|åKĒÕpibMōš„/ øpx¬·\ń¬Ź 9¦óø‰…[gE®¹eŖ¤w®Ī÷9’„AgXˆŗ¢Ÿf*{Ī>"šz¶Īa:k5;M \[RJ\7ü¶Ųæ Ī¬Ŗ^² —4°›qsD6žuouŃØBևš‘+“&Bā8›¶™āvØPE<ń~(7inšĖHęł _×&“Õ3 `·f/=e÷”įŚ.}|ń8Yl\Ł~pؾ•łżšmtĶuAÜC©ė_³ ÄōµŸfwŸ"‚ŃŃļģ~4Ž–„?¢(ęTzŲåéÅ2žZ±CŪ0«»š}’9‰& »×ƒų·ąņ”Q! «žœ£ŗi`µ{įĄ(M¤ē}Ųų’ßKƒõģFłļnĻŻ,ĀIŗŸ·W]4‘!žk›€„8Øģy™ˆŠįTŠ„eO‘ ’+ŠØłŒ˜— ū’*J Ē›-Pė0Cuŗ#50u„„¾®ģCóĢŪZõ¹g0D˜¤ŁˆÜņ€‡‹ĻūØL»/łśĻ2ŲĒ„«?R¾NĖ \×qpMi^®WęfīļcWóÄžĻ]ņŃå !;ź…#n®¶(å’xŽUķ×/źc¤Ē½›4Y;&lnȜµu/ń›*›Ł’Hżo·< ²—;xIÜWŁ×Hp—§Ś¶ÓĄ ā'³”-Ā8‚ØĒ>Žóƒ§×vrŸņ0jŽ„ńŌ>„ƾDߣłC.>ņ–s—*F  ŗ‹UŲU}1Ēü=č `čYäž¶UæĄ$gFŗ0šŌ»OJU~^P½ŌāĆīm“qėm:oUŁĆt¼!!śqmŸ~W^š²^ŽRuV$ę÷ó¼Ņ ź8V4ĖŚYnŚÆ"ęb ]›%š2†½ž‡;™Ņ`ńóņPÅ™ķčD–åeńVZSŃŠŒi«œJÅFK»Æ§Tķ»ÅE©Ÿ€Čf›ä‘˜.2„ŹĻ’žH”qćNćĄ;3'V÷ÜįŻńŸæGx“R{æø@Xr†÷ŻX0?™£ŚŃ˜NFJŗÕ@„q7Ę{¾źśß‡ł‰«ž/Ŗ \°ś“œ,ŪfÄŠ?³q j—ŪlMéó ņęćźR’fg{XœŽ%­p€DAŚ ž%ˆąfqŠhšžģūS„Hˆ…–čŲE¹£ĆUܲźžŃ„#2bc_$jŽ“KB¤zŹ@†«į] ėŲꆶņĄŠ_ŌJqŽ®xŃ*žļ1ģ&ėmõ:Ģ·ĀĘāJaąÖæ·üüL-쬀*įæ~²XŁOYJ8¾C“*Ķ$rm ķĄųŚsr¦`V— å’ĆzØ/sæ/–_Sė,)C¼‹ahp7ȦVd¢R2ŚĶØśxC|Y±%õ³€ÓT~żŠź'~ńD7Šõ÷9vu·ĢtT,`}Å,š~i~²_gk™æłJ”ÖŽœ_@…J슊µMŻ Ė(3ŲFÆ",–zų_āŠéį–Ó‚Éųģ#ĄŌ ˜Öķ—Æ ÓäŃ'F`Ü|”ź6;L¦Ś»t³*ŅŪ+°ĖĢ:źā/cą?×Q“‚K5¹³ā'ąiQgœģą™}m«lMvßĆÖŗk:7ƍh…“‘š÷›×PS„JC]"xßÅK;=üėeŸ› wåD³ŪW_Šé…Ń &X¦ s+-ŠĮßϤŽD9t"ŅIĮ8YŠ ß ž¹ņtŸĢ;®’’*ć}riĀ`CgŻĮł“Ė‘'‡U‰<īL1Ģła@Į«¼ cVpÄJŃŅ5.öč=RŽ" a™ŗ)f’»Ā7ĆqŁyĢčyō½ó‚„yeˆóčUĪź­;1–(ĆdLēᆬ +’Pˆ•#™“ćó¢óĻø—ÅŌ5¤Ķ1śg-½ w qOÜų„uв’dŸĢöe®Čź•n(\ēYHĒÖČ+WŌĘ"’” ˜®Šį*‘Z Kg‹©žäĖą©·ż ohI9 ć\ ™+(µEøDm`\Š©P†±,ĀDg‘ŪpŲ‰·cŸv€_7Ь‘»®Ę,T1ę¤ū‚”“Ųģ.?6Cu£Ø‘Ö±<©YĪĪm¶¾ĢbżMVÖ(ßē$w[\I.ˆ¢ł ©4WSu JočŖ±e[ż^Nyfz?†dAŽć®Jåw¹‘Įź‹œå©ĢKŹŻöG<äQ”¼q>ø!Ę»īPŪĖ;Ž ½Eū4O‡nįœ Gāµ\bK$ń>ł!§”sJO+OqsKœ/śø=”9óĪōr=(Žč,ä. ŻSŃ»¼²ĄjŽŠ:˜Ź3§¬ ü’Šą“ÆøM ĮrTļćlouIZļ<«åü±>8“€ō ½CŠĘ^PYŅŽDŸOÖm„›Ń(«¼RœŹ°‰=¼yüZ\9«¤Ž,n³tŚXņĆĄŽ×>->b•Ē$Awœ×šś“F—•«ÖÅYųņ…źMJµXg¾J6Āą·3ŖRĶ÷įöcĻcĘ_>ŒŌphїN¦1ZiļY%Wn·)G ]ĒĻæsj©¾ł¾”‘7š‰§v8i¹v­ųłŃEĒU„VħŖu()nņę£,$M=©IQ&‘z÷£»¹čżQ Ėü*ÕÄ9Ŗ;=R«2źō{½źX·/ŁąiAvæ‡i(oöÆŚ&Öāąi£^ēŽ0·"ĀP9ĶUŸšžŅ^n”Œ ö*æL¦™ō27/gR±ĶMü”ĻcøÓ8Ÿó~~7C=H’e³#‡cŌVž–ģƒkD£y±kؐ«V¼.ŌXYįĻ€ĀośNu ūŻ2&óu„¬ęe|ćÜŠŗJ°†Ļøjč.˜¬¤@z-_ŗ{‚#aąÓŗą‰•?xwBžŠ Š cńŁŃĘPż g?cÅAĆśĀ·o’4Žé­¼ŃŒ"p0*Q“‘*œĒRhĶaęOĪ»&)u/lHŖź?¾V,.ʐ½+‘ Ü©J,šZsł‘j1ag¤ņ5ŖģWĶ:^[2Öanä\bŚ i>±./+”ŸR%{V”±«(–3¾ŽćęŌSŪļz]b@6!X|`cåŠĆ¶œč.ōPÓx@Ó0ņa;2ˆ7‡Ŗ9i\nß<_ ĮÅ‹d<¶Äƒ2'j<¹F_–܉̺«WØšĢŠ¼ė;åu‚„ ́¹+()Yć.öŽfķ@,Ą‚ōŪ§ĮŚö/rd@]ōi+īSŠŒ7/ŸDH5H½n˜0©[?į}źÉōWxeŲµ„ø¾“˜€r+D·‰@»iśwėšŠ86][6‡¤B 1°D¦Å°@B¾ØÓZ|t1d=āæ6LF,|¢;å¶ ż=$u7hśH Š®ŚĘü § q»ŌČĪIX žg°fb—õ•Ų™…¤r  -‰ū +'7hĪ F1R.½ž96Ė©!†:[B‡®¹ßĒŹ‚āS’rO k„Ͻg7µšĪPø‰V:Īvv·Ūķ Æ²”ŃU+?ļ­0ˆēLšsąMp¢1ŸĮęqUAŗSņ±™q-žĘQ…Kń£é˜²q©ŠÜÆę×ÅŪėC6Žń0,ˆžåoG©Üƒk•ŽĘœ'E•«{Co΁v\X! [‚ĄćaQ(F¢‹ zTOüC!ם-żC PӁæ8¬ČæįŠÕpīÜäՍųĮ°RhŁįüoŻą;“4š}'±'ż³qnx=× 2·~:5ŃČ]›tŠ_NŌV~#Ø$6.赋mUJK‰² č€ f“­`5<팺“Ķ» kx–ēæd—Ź”ÜCAśŗ=@Ļ]Ö’¼]{āc%‹}Y@Vdq‹ĆŖ P7-ßVŽGį›…óIZ£c•Ž9‘’ČŒ{(h#r˜³šŹn”ö銦*%*æŁG‰>Ā(iuöµÕ„!zųĪĖoĀr÷¶3ČxX²ŅpżŪĘ[ŹžÕ6u[Āt6xå &ڊpžī TŹq“\*O×9öGōśėĒ08­¬āČ‰­÷¦ö”._\q|Č­e1ƒ½Œf“"Z$[OĻKĢö+õgŠäż²ĆÆ£~q:蜤»ü Īč.…—Ef%ý5)S&ÕĶō取Ži=žį÷ļ™ •%^ÄļOŽųaÉͶČ+·˜µŅ|&ßžb”„ŸoŹÕ`ó…’( įrÜ_|»b0ē½Ü5Ģ­Ž KP§¬čܼ”7ø(ŽZ5#€":ÄzxM MŅ'(mÖO–‹š«_ÓP˜æhŲVB‡o–Ü}“—›ˆoĮÆJøafųņē2ƹ-¾1,ƒA¤„ 7_Ē™Š)Šp ²ü•Ś\ÅÕ7»wŚÜk².O[ź ŚÓ.M­^ ÓŹ †.}%9ł±vdQĀū·„õ™×”§s\Ž’Œ¹9g:įfŽy¢ ?gŚķ”ķux@»‰e&#‘¹jĢ©“Ą!yņSĪ…œ½5IvęFN’xĻŁū·÷ų/+±†Ė²ÜABĢ{ž‰šŖ1‰‚4ĪNüÕ9œ,NŻ–š£č’O@01'L(½e8Mķ@®n¼¶Õ\ÕwŅU2–Õ¾zƒĒ‡2@„#’F?7Oܙˆ CU?ŠļpmŽō†ž„7u’vƒ"‘©ž'PŅ20?¹>ČNń|±e»aFšÖK\…’ņŻTCéfDĄČčsi1“L8+%|xzźmh*¾Ÿh’{z¶NūKĮȇ:¼sBĘ}™īļēc?jy=Ŗ§*&C€Ėӊ»Ī¦ņµźFވU €ČÄ-d;ķć½ĒP ˜={NĆ-9ӆr›]G))7DöRc®DĢüĖŚ{惱ł™—ĮW¼™:Ō&ĢįŠy¤Æ&e(čvLŒ+ĶaҼåC6‡\ 5tg{låÕ¢2Ų%h­× ?[mĪ}WŹē}IęŲģŲé ,7ĮIt……ó¼BŒ1 X‰sÆ@p!»üēeõųÄ;WwеZ_Ų„EŒžŅ”#7Ssq.jö^Čō2Z!\ßzĖL~©r:ļ°7žbĘŲŃ›Üš`“M%ĢZŠYü•`h}[Ž“Š.4a¢l$V>L5-B§clT†HZ2d²Īz}Ó+gś‹ ½?KTŽ“ŠŠJŌēnzņ²$ÆMł˜įŖõ|0ߎœVDCźYv;lŒŗžŽiŚĘīrʒž”%3ø}™æ5HX„ģŸ&ƒżAŸžoØō 3ŽQvø34(ˆŻŲ×ōŖ¬cå­¤.›åĮŻąj0šWwń›cū7ł¼gż±ō‡3S2¤5,øPĀr_hūų!VŲ“(™ļ’‚ŻŽ-ņ01žPķ>—Ę)6„ «é„W'5։C[%bÅ#Pło=r¾jūcÄJ¢fżVĶŠ*^5(4ųō Ķž»Äį%ŗpa.A¤ ¬—9ģWiU#—‚ĀŲ(u"æB ž< PMŗĢ¼ĀvĢ:­jmf”g"Lj@ķŒåų¹]8ȑbńæ?u–iōK&Ā@kæ“_!Zg‚Ė·‘u~UpæĀCcRŗÕz» ŖžŸö]Oķ0źOŸ9į*'AN.:7b)’ŌØSK‡‡‹]jśa³žę@XFw@m隈ڳԟZ|%~V[˜ļG8āŽ’›¾Ģ³ĘœēЬ]Ö·—ɧ÷› Žu­‚šż§#¹GŖ·zČā_dLg„üęUŲ,,€Üż»>&eĢĄPd›g »,uaŹnjž_Ōī7°©÷°3łµ¹aJ÷%# ģ7ĆšįŁä[T£˜8ī²źˆĄĪ¤˜ēӍ–EóŚśņc¶6a8®kūz­k%“ŒhĖ\Ś!?¦(~䦰üń†`^ųÕw"1k)WōüÆ"^č3A³puŠóÖ‹ég!Ļb9—žBĪ’œĘׁ†=0RŹf‹ŖDsyTÕ<•(@ƍѹ0H°z}Ņ/ŻÕM@A/;ņ¼LyTégąÄ¢¶GĶ÷ł»‹PöÄŖ LŪĶ„3€q* 1I\3jéEě¦ÜŃ7Ńļ 01d‘ę“E½*>r‹JėxŠz…`&×Ē”•³Ėt\ü–Ū#ČHąŠ–© ĆJō³8äDšļ:?Ķ F‡Zņ}N0mnĻņ ¶ÕčQęEMčåŖ‡« !ōg«K3Ęȱdóå-XY+Ćų§Ż“¶·˜JfŪĖŠW(cYˆH^|?w²xžz­ƒBkĀVŹ0¾KÉ—Ž„å•v‘‡oŽrøÓ”X>OĪquŸ*B•&»—tœCŻéļz¬Ę Ÿ’ µg«N\ČĀæ˜E¢m{T ’Ņń&]^ČōBŽ…Rvҹī| ×1S Įr‡˜‡>x;ŌõŸ>|²PzšŲZ€®‚»b}ĖĮ%6 VGu5i Ź®‘'h9Śś§Tł$&ŹŌß©}H‰yR9™”j&ĒāųL'¤ą@= B¾' (b Œ!sš}AÜŹ²lX„ŗ T»©7Aņś–\G¶ÓĚg&že“yxUÆ×3q{ĮłEzOąlm(­x¦h8ąē_ĒŚo”<˜’$µæ«¶ų@7>X•ä®„ō0?źj7°å•µJ+Xm!4 —i&>€uDP˜£ «ÆsyRäGJO†ųsĶ ŠÜkŹN¹(ŗ¹ī†rAŽ+“]„²Č½JB쇻H¦‰Kˆ•†6 œ–S°Ēd"Ķ„š'=xžµē¾ŪB婚ɔŌT¹„pfZT}&"ÆėÖŪ›Ū»k¢Ž Ęń»_÷Śū}±A_p#ō™qó !€h“Ńø?ˆ`BČΤ„ł@7õ”ą”A{÷ī|.«Ō}ūe(Ńęjī‰Ąø›źš»†Ž¦V¼e„q&HckVu™aüšo±»ŽŠƒšt `öe€’„—a]EVœäó¤Ī†KŽ‘°p;•įÉŪŻśš§å–Ųź±Ēpx3“č3©7ķć¢ÉŌßŪnBÓ‚OĒ4Ś‚&CʾƂV·ā“āVnH„K¶†“ÕuW< Kt×U±%:0ĪvėE:JoįóD|\öóö˜®Čb‚ŖŠóAe¦!"*’ŒÕÜŃ_ŀ–1<6‰“—Öüj;Äŗ46aÄCpõeé•Ņ’ē 0u’ĖŗĘ®®āKļ=Ł ‚Y!/Ŗ‘ĆNģWĒ’’½SqĀt ,dņ+ Ž ¦ .¼\W1adÕ<’å½±"m^ovrģ^ņW¬ŸÆö3 ŗ\‚j”€Ķ­Lķł°„C1M ÆßėžŅ7G¦±¼į/°ĢėÄV|`ĖKxšxøQ+ÓKµ·N§®Ń1ēzƒ§¦yŠÅ†čpĢä{Éųś:čłv£Ä:ĖGaóŅŚjxą#ń¢ė½ąšH×ø½Ģ„+Ż”Į†ō.‚¶¾Ų ĄÅį¬c¹Ō«2©ĀĀ7Čå!ie YŠ”ąŌBDĮ(ęh ĄįÓj‚=-Ę¢'ŸL…›ŽV„2ž-3ĶyŌ„Lš†[‚eJ›LœwO»Æ‹gTJ˜–ōčx¢ŽŚR<¾2¾«ÓF ó 4c}į\qيŲM1UlCy6žF—ŒDńvå;TÉA2/ē`žZƒ*ģķ’Ō“orNÄ/¬½fB>ēQ$øv«:nöV1Š¢:Őwtö¢P~Ė7/ ɽYõŲł¼Cį_˜Śń­ņ}11Ēh†SAŒĒLQ‰²… G#zöų¢3 E=XJ’āKš°Œ/ \Ÿšu俥“š%JĒ­%ˆŌ9Ź ėLøŠĖÖėcß&Ó#²¾`-I-!’dZ€w”J”Osö÷QŽĘ›Ō[ ƧH_Ó"ņ%“²Un7āśźŌ=^źĪp~‡ĘĶ„Dw:ō‹ģ<.JĪŽoĖ,¤aš^’}ķzßz-ÆL ģäHó¶.Ūq]³…’__óĒć'®Ńѹ=—3HŒ@¢5N€ģ°ŲÆ^Ą]™4.™w†d%¾©•1Ka}§½¦õŖōöʝ«¼Œ•vfäØēR'–j “÷¾Ÿ|Q€ŒM§Ļ-ײĘūŸöŒ„Vż9Ÿōg¹»ę„5Ü·# š°ęw[t.³5Ól.Ķc'攓MD·E¬ŖŗŖŪyŽÄØGU¢!ŪÓthėK¬†×‰žee å,ü¶Ü4Ś=j·=†Ā\TbŁä«3]œ!D61OüŒŌ7-ö:e” Nę՜}€ē”D?ę”é’ĢšÜĖųÆŃĶŠ]ł‘“ˆ‘€*Ś›ŖpHÕ®`jJ/åDü.®V³ŒŚ÷ņä(½'«,l3z«£ÄĮˆVŹb:]ĒGš’d!Äy)ĢąĀ;fČ+0{/&0ėābyo\Ų֝ŻbѬIYś‡Qó–;Cēģõ1 <ƒyŸĒ_L,ƒ瘊æ =p}\sŲ{)v·ņmNtķżQ"9?§ø 28 ćū-Ēp_ĀŁ)a1a“‰ U@w Č®;ÅMƒļĻĆ8פsJsŅ4H0É·¤o ‹ęözlt%z˜›ęč[…i%ŻŚ^Āf*$¦æGß¾d½L^–ĖųŗöQ CÉ[揌2»&ju‘ry‚ŻB“ĮØ3Õ5h"ōg×µ|‘(wT½Ī©>åĘż Aŗ²ų:“oy]‡®`ścTū^z•éŹÕ pĻ\@Åå'?öxī_<ŪŹ£õĀr)÷>ŸrR)aŹć’f:āXĢ·kK–+GXč> RD`”éŗĪkåŪV9‚‹ąõ­hĘņ+ų‚ qęĄ]|é”y`żžsš2ʤźŹÅž™ÖÕĮ”¤ˆGoß8ĶĢ"…k®@%ھœ#: ‰a¾'}ĪÓ«Šp•8ü“VęU§>»āVśŅø ®°ēņū Ś5v®ŗŽ¼‡Ž×„¬’ßv[ųy_fäчtÜobMiĖr]¤/4uM®|ķŹāBcģ·G‘ńń8ūŒ=Ą<œÄņ*2 B—·rd’ݼūøņdąDU‰Ą™ę¾ū_€ą_ū~®ĆUęF¤¼+~ąŲ8`źŌČöŗIĪ¢»óÆbł®ŚWmTł.`įām]ņ»ßO4ŚßµłŽ‚¶WīŻÉ Ÿ'°ŽTc/`²‘ģĢiÜ=l<™, »Etq™Ķ(YōŠ_$šTeŽ·ė4Č«Ęqw’Ź$ŃŅ3£ø&‚ -N‘.XFf^Ż.;ß«¼bN^ŸśXō½'Ŗz<ĀDGŖq¼-õŃ7ī)ŽĖĢSVJ]Y2^‘'żĶńĄkŽu'·KHV©*ż¾ČķÄĒlgßįCO¹õ}ljČŃéznČÄgķ×чģćÕŒ&‘#$ļ!öX>®šŁ9ÕLŁ·_NÖō=äõ Ļr`ČS*– ­ģķU±qD°½FÜjēŚuęŚ4­iģS>ŲhEcs3=G|ō<U·ō]uDĮQ叉D¶ńaŒ˜öš[g}õnŽŽÉ–2TÓĮ$Õט<_ģrź/·Õ] ßX+³}sOه…®ØĢ¬ż#…™Ż dū0š«×z,©ÉŹļf‚ƒAūŽRoüS؈pĘM{Ö g®ŹŽÓ¦*ūåŗķ’ ˆ,ĢDģN-5Ic…huėK—×HA²Č°»Ž­öŗų£?/·Ī-" éšC7­{SOxČü9gl3o˜q)ŽŅgņ>bÖ5`BĮʁAęyź½ŁÅĄ™!/ūWÆC<źM`ζcʘ‰ DīĖ·¤Ķę¦Ųd$–s~”’žšÅHHqų\@h4’՞čė)‘į²ü˜õ\q“Qō;Ųhs8:eƕ޹`¢źsXb;ļ®¤ŪćŪĒÜ×OŠ/"ęnJ žd}†¬›Äž!“ fÕāZ~J&RéˆzŹV“'y2ņżidIņWǧŸfbĮ`™Yk½Ń āyš¤5Z.ÖčQ‹‡ŻqŠ)ČN‡ēÓĘy­J’Cµrē²TłāĀł‰4ĄŚ#†!öÓ5ÆKwrĮF"čQĆu7ŸĶŽžĪ-fB<źG”l8}@y/ õ>ŒöļGtg‰4K¢”u,±mzˆģ€ū Épwu+ŲIa埽Ėć0bŃå• Ą³%Łįr¾J“Źz}‚ÕEŲĆ6÷ ąż!¹(×č$^L]üóĖæo”w ł5#‰¤aųSł{Ÿ“;gįa“+9Ö„ķ†˜G^ŸA_»āM’*[”Ė3f·H44F?ŚZÖU×pÜ6¤īķ6Ć#›æŽ’«Ņ'02›8ˆ}øZBĪgęąÕĶ-ĀʉUćé‡ ‡j…åŁŽ%³ y|•’‚ƒÆC (g«ß”§é"qüø^ļˆt:w˜ĒAw§Óš„¢É·ķgÜ{ɐ°žæo ±)‹ Œ]y ®)¹O€ŁæEm$)„-q³` ¾µY`źrę9‹Š ¾reM(±c \ŠĀ•/г¼Ć~Ēb¾nT+CĒĶŚÖč‘]šYB/śc,0djJ<ˆA‹+=8¹ē53Ÿ,f–jā:ų}ī/Z8H‘ŠÅ“Šŗ Ū6Æ[Ē}ŪÆÆ‹A1ŽC ż¤ž¬¹h×&¾1ī fĒe³Ż**"›Żģ°æ5=SŠ!>/vha”ŗ¬thRBĶiĢ ">ć^ Ńż‰\’gÆ"„ęā\¾Ō÷{ÅBŽ÷'éŽB)6%l:ŁwõÕ²\i;|v“GÄV–™~ ®øuÕ—š˜¹šź0U‚ÕēÜæßsĆEoĆŹä d =0×J¾APŠURīßÓĒfck±c.£rUłµ˜ļĮn¬dA 4P‹Šm&ł’’¬p.ī|4Ńoī4“׎+ĖŪķz“q ģ•1ØJųJ>^ĘŚaté‹NøØ)śD|3SĀōą°ģ;żæś™Ó¢5µĒ§ÆĄ:z}HrPlm2F}+K:‘67ŃoÅÓfĮ”\| q&ė•7GmIt[C†7HŒ|–§ogyļā)܇ąsÆ%ćoräcF¹ˆbZéĀŁ«ŖdYĒ ÖæĮ2ą’Ū‹–Ło80ÖØk+æN+ėéJtś23ŠūlT^EŅ‚nōz°˜Ó&zŠfҚw»CA ģ‰v½Ąb…/†!¤éÄÅź‚P„oεr–uęʖ:,ƒåŃØN+Tvd[‹vUk¢“Ģśób!ö6 8ŁUöĪ ƒj–ź”Õ/A­ÜųŪĒlRPś'aÄI†cš¼.ś dmī˜ KZP`•ĆŚŪϵä‘U>įME5āA±Ø[īžRµ)Ą<( ֙‹€¶Ųå^¾‰Ó)Š‚Ćńńī;#O@OŸ@ŚAĪžŌ£Üš7²Œ«Įžüb§…•v [Qś§ŃRĀ+\œ€¤ ą:ļĄƒt¤›¶_±|öx£œÆQIĘ±rĖYiZ!,·ø1[Č8_ėāuiņ9¶¤> ś‚–Q$éĪĆ;bŪæ¬,®mŚS×_ “fh_Ÿj‚¦ö±įŁ9±²C¾"ĒŁÄŻ`:'FŲ£¶ćÕ“æ8IŲ‘Ģ~fņb_őrŹłõØdŪ”7³n1- ÷”«Z¦>€2ėļ”%–D½(alm¾`Š­ÅĒÓWś!čĀŽW²’ĆõŠ)F¼Ēkł%ožŠŗŽz5b Œ°åŃSIšń{±g[>‰Ģ˜VH®č­gu€×U[Ł7x@`Ślyˆ‘Lt4/;rK8P ÆQ4ń…J‘y/kĶń’ā®Iū| -ż›$:ą•ĘõdĀņ\·vkā„Q‡Ī ×?{—awąČ—>…—P†ÆåŚīXčĮł‚¦}£É¼ ÖD2?iīO™@Ģ9ZøšpŒÉ–ēßŃ{yx÷ƒūxy5ąÕšīV=gų•Ķb‹«Ņ÷†fł)…ų•o Ó"Å»%¶#Źż”™yāøķ\j Ž3Šßƛ7ĻŸ„ŠŲ¢"Šlw)ōu_§ßGļ@ lć-ÉŃQ’~qł{/k䌯9ę'ĻŽ„” ?_ŗUĮDź ˆUV|ŹXĮ6_é$”'‡÷a‹võNŚ~X87Ę’IČT‚3=P£—ē@"‚³]Š#ŖŲÆį.Sv÷ÜŁü8¢&_āOP•ū1å2ļ£7™aƝµøS†5}UcšŖpńoą&@±RÅQK¬ĮÆ^(m'µEm-eŃ>ųōĀ¢āź ×F9ÉŌŖĒ”ł„lp¹žrҼ=“ƒ»ńƒ—<ņšļ4Ÿ<9œėɝzQUOĪż–«k¾į¦y°U4MŲ¤ ‹>ŠįWܓ,2*rqßķ^<·hń‡ŠŒ0h¹ļ›ŻÉ×A"ē;ŖŠ²]®é‡É¬×:śRcŽĪĄ{Ō0Õō ±«³Uó/•Ż}t”H(×d20lyūĀ=9ną,­—œ& ,™­óŅ“b3Ķ„Og՛fĢTu~hYćńģĻŁW„ž­OaŠā1ĻŽ&¹Ń0ä®~É$ė7;OOx9SP)P›„Ošł;Žr5Ū{†f©{D°R“;čņp¤LDɲęR ꀊŁksc=O óŸŽZ'ÆY{ÖztņnĀ„M ĢS±'.=lx…·W6M„B[ÜA6“Ż9«ŠXNčՆ©[X€ÉÆY žĶEC«vśÓܾE9Õ¦[” E”ŗ‘`l<|R-«€įo HE’‚1v&Mæo£:KI[¹­!ü%Ev¹[ Ś: ¹¼Dvź äö›:§ ė;ꬿɬą£oĶŚś)`ѝŅH_@yąęōń:ÓCk®ūQu⤽öĪ:„żżDåńKźŠéūßłwx¬ą ]€¤™¼?•Öąd T‡˜iE§õc|ēÓå`h¢¤RüaS`(©Œ‘Ū”¬…sh%”n“ä/Ųh¤–‚LĒ[}J„ĄŅłĆ4” œOīγ ²·lį ņr§+|†>'Ń'LąO^Rœ)†K\³üoÄ9ćē›Ō¦9HŹ€F4ī%ŒĻŸæ„|^Õt »oƒlōÆżä–wÖ Š?ebb«÷L;N-wČ:”R!fŁ€·héj;rŽBŚ 5Pś‚Õ‰©@ēnG/am²8‰’åsĪÆ’÷(­ĶfŲ?#HH 4ĪdrĘķś¹ÄDųĖU…ēßŃć+ŖPd$ *ĮŠM ,­h1•ĄÕŗęüˆ±źzŪūÜõsŸ{i•möœ6¤;Ķņ‹$mńžRNŠFisĻ»“q­Ę×÷ž.Mˆm‡¼Ż|0kŠ\«ź–[Ų÷‹v śqčņ^”=ÜFĒ£9h1f²ė-)÷bĖ#Ķ>»hėĮ*lz÷Óf°śI4Ł` sŪ¼J°Š¬ĶŌ ¶OXźEc%fś&ŖØ§ 'ö#–†ÆsyŖ‰PÉŁēĶOBJĮĘ,Żxt&?“° Q ĶOō–CŅ:”žIŅŽNsĒŖ©čį®MšdŲĻłGÅ÷ń‚JÄ[ņ5¹6€źƒtķŠĪ•y̰oŅÆK/¢/vdV‚¹Ęt=ŗ.'EĒ%n:ų½2ūØąrewD’ś²'9w;Ż(z}Eaė8“ˆ)žŽe³īčĻāņüˆ.‘t©jhŽÜ×{ķ­r!–31į•GZŅo’i„@eėĀ * Ίxž+# IŽ8ćéō9$¾B¤q«pDÓ2fg¾˜Ūīāą;„«ųė—¢EęŹqz§S®G”lęu)WU+ĄqźĀÜR-glVéŁ@›čkZBÅš×RļØÉ¹°Ī˜¾.Ž!b]D¾b”Ē—+’Ń:$Ŗ­‹Æ8Ōģ—–#_‘ŒsA¶w›Git_ŽvžĮŚŽłƒŒÉń8‘˵ēĪ™U2©ƒ`ISźyąj!,<ļēéfŽå Į‹'i¹ø[ä{¶VŁRP‡z;ī÷Ј?\ư«×2ī\Ļ—õ6Ć„®€L ķ9=Čf^‚1ńb’ļ’Ģ̤‡l¢B!o‹Ó,’łń W[™—Š_mE` 0Ł—.oaŸēµ!Ɔ#g"š,MŅMlo[MÕ~æøÖ-4É+n“öŪČņllŗyć“WĒžÖŖÉaѼ©’‚ąłc\æÕ„(fČ^ysŒ)fŻķ÷7VŹžł·ąāMvŠžŽž1pNS12'P}öŹv§Ā·×%ß[2fŲMfń{yz ś0I,µsŁķŁOg0ÜBń-ØĢÆiÄŁ×ļĒ^•'!¢õūŖ2Rōkīā%ö¹Åž“Øõä’ččijÉćŹ Nü/WyWV³xÖ•lŒF(Ōæķ»šfćÅŗ9$/ēĖ{öٌŽ`G;qčfģĘ@žVo¢ŁĖš¼jT‚ cĢ’v¬°(œ$jZT¼W¦L•²?žéKg“x†[ž3žĢøąA9‰C3;Ø_r7^k­—5ŁP*s­ĮĪJ.m}»™®sPćW{“ķ¹Ø&K®ŖĀĮ¼’f7">hŁ ī”\xWަ°ĄöFĄęŌ\L>éīś¦˜3ZG\X[ $0"¶+ŌĢå]ˆŃ¶„æM•Ļ»1+Ū+Eź){ŠēČæ¶ęü­o ĶŁĒm/ ™xŸ†Ÿ†\@[6ŽBz¼›Ō²ģ¤„_Ü;4S-¹†1Ž„ż`æüōŽŲ—ŗ=xØ`ō¬_–' ćd{ü‚$õ H9pK—ę2ĘŪŻqÜņÄ!į?_Šż‹0[kf*ŹjŸe3N!2kcŅE<”Ģp!ÉÖ¤'³z”hŌŻ+Żęk“fįq4]„$Ī›Ü1“%Ŗ @®ė¹¦ņąlž®IŒµē»!—ųaøĶ½ZØ-Eę“jöćŪ«µ ’Ø<Mįč½ų;©ŌJ‘”\­‚0ū'–Ö\Ės;1_Ä3£VéJÅō@%‘Į*_śЬ0žżb¶ k ˜Ž+CTQ£:TU1āHĪɒü00 之—©;¾•ŃÜį\›Œœl”Ū"žy²kŃΰóh ć3Ü9Üę*CõÆi Ö ł šŖŃŠÜ7_^ÉŸFMēj€ķ-¾SN°ś„ē<«§Gӓ·»ŸJ·pŽY¢ź“Ø­ZŠsr€œŁne¹Pj]¬ńqķÖSŌ® ‰³‹dˆL…hÅBég…¼Į[Ā›Ķā<®lŪTn ŒŗKµSYņšp|‹°ķm>+&"ø@ykl`ŠŠń²‘ 藰ē{U^Yѐ?±jĆ“QA~`a’įMŚćL~va tÆ[`»©84ųąNB%®Łģ`~ģŅf×џŸ¾;Ó?ʆ.¦³k–<ó¬üö9<-<:#ŗŲ[µK]üOęnū' ²2ÕY%šŃ?c“&ŽīI÷¢±ÅlüĶ ™rå[:] Ča iŪ.©:*­†Ćżs]Å6bE!]½MūÆŲÄJąģŠKŗ_ĶCØ]kŅoaZO潋ĮłSŖ†øÕUøŗ¬€2éA‚,vŖ“į…ā­94Äķ;›^)R‡Z½t~X4u>†]xī×v|'ZŃM£AŒ#/ČZ8Üžź6ąl,ŃźØq³†/šóŽÉs!så-j¦¹žh§“£Jž£ģgĀĀøCZ7ž~ą`Š 4>~$å;qéįRSę™įŌ5šp)żūG'3L9s“UB'\šÅšrā6Ăx Õ ¦Ś'_šIģIšŲ”R³laSnŸFXWe?eI't±»śH_½dJ>¶hķ`»ģŸüĄžŠž¶Ėw‹8śżr»ś“f­ŌG϶™’ž±æćƾŽ*„ƒéšģØšŻCY<£Ģ Wżųś<§é'ŗ5¢!RÅäĘųvƁæc 1z’ oŪĄŠaŽśR9‚ÜWI3ܟE¤KD32vÆüŲ÷§…*“§h{ žģ/˜wT FśžYZķŲō) ńmm=A¹(P“øc¶5ß®HÆIœ^±}Z@„JĻBõēc’Ż”ķÕĘņńd{ų˜vĆ¢„ł!‡ŁvŚ” ¹&ß»¾j@ż•9Õm›=WņX§:D”Ƙ_tjFĖÅAĄĘ-ß§vžrŖ\$Ć%œ,&eźK§vU¶Lˆ›”aVÉ.6ŻŽ0ymw=jĢ… P]e§ŲŠ~p&ņŹ Ŗš>2*Yź”ĄĒr~nfß(ͧ)æ›Øp˜vOfxś}ƒ\ ­ ĀcĪd{J֔‚W\ “ź‰Šü-ö„§’ĄŽƒÉĮ©fœPl`¶ém³·‡ˆ¦GBĢ̉α6’dž˜–WRĘ£­'†Ā’½gA#ņĒA#ū0—ó oIˆ^ķˆ=«“18`®ŹE éYuõŌ h4±Ź†­RC:rŚļ=zĢÉū©8c©k3²į¦Ńšē±x½rvwXPxĮŖæų#,‚u;Vm6ˆŸ£-ZG_j[øł)$ēęĖā}ܤR€7Jsŗ„dŅ7§€PØFFR{ƒ±öž/6”¹]ćiŁü7s«<Īäµ®TŃ">a ʼnžÅüŹÜ“~=č‘v03Ŗ!mĄā÷Ų§„›M\Ķ~Š7ö9OT¼ķ¹”H<36’/ؖĮl1a$`‰j”Ēõ…Ą"Ū>1ŽņŁĻ–)”7ē¹{ećœõfŠą8ó ”žåuźłõu$:š"‹FēēoŒ7ÓI…b:\”z¼3h~ĘvŹZ %®æ;čM§ļUŽūó‡ķ¶±’ĮÅX±ŽŽE©C—Jß;äg3kÜ£‰³žb¬ Ż`V鍌7€d‡¢„=Ļ”É7«ĶXZŻ\­ŅO²«/0e±<ūOUŗ§yŹf«#+½¦ĖĖ‹XU”ĒOĻY«lD×ä”ȹbµ ötœ)Ö;m tu-čė;/ ē‘›Gbį\yw2ԟÿxe|YސŲqIńØ$† leChÖGķĄ±WĒlė)¾,ę;¼4%‘)øĪė™A`t†O‚°żT†¾FŠ›0,óHć·Æģsw}†Ų¼-X’š&"1¶? v-ōvDŽõ,W%<9g}”‘ģI#,ƒÓ!”ŠęŹ~H‰W:"$Ņ Ć<|\“µc.ßfŻM!o· `L#„ČŲ£G( Nžæóā7埲ōƞGHaÆÕŲUŌ£A鱄ą@EĄ ÷wM¦ś:įÜqų8÷(žõįGé¢Éüv9|˜Ņ2īC’ć[UKµĖrq£Ŗ²Īé7ß욹vo•’ßļõ¦ˆv³*CĄeŠš£ƒ"ō·C5ĢI’:Ō@öD;%¹ń&@ K«‚™×wŻ(CW‡÷üŌ3A -Ā*¹Į]癆Ba±W˜ē6iÜņ§Žtõ3Wł0ąEėŃ9—Jp40Ģė›ūh ŽNńŸ“ē@$$L3&eD=—$ōÄVTåEIf ģ™ztē™XœĄ¼Ć¶ŚMņ~‡fžՕ5¦yu­•Õ.rjK¾(°@”š„¬(ó«·_nł/æÄZī³”\²r™$(·‰^^æ-¹tHżĘz=ßē ²˜;⦄3_[_ Ŗ ‹T.ŅØ÷‹q'½ŌØmÕåŃó_tjøöEśhŠFf–ǦFL‰ÄśM Ķ2®ē¾†õ|ÅĘ7ššžÖ½s:'Į†z%XŽŠ‚5)‰ÅQó'ŸŌD tǚē“$gJDčĢī—~Œi齜 »Ūäy ;ć GĶĒ­VĖŌyü› ūŠ|dl®Ų(¦VPœ:jä²Dæ–G6Ğ3 Õ>;˜wš¢Q>=+1ż%±J‚—śūBė; Ęʈ·.ÅNƒłRŽR†Ėsé¤i–Oö¢¢nīŅsbü¹FĄč Ž Š å^uĮ)Ń0*=hē²!f§Ąü1—ÆņvLņĄ_5‹ ńjRÓā6“s±L†¢Š7Prt’Æ®‡"`+z¼rƄ tŻ̼?BØFż—T»zŅóYĒ—;mcAé·öżĻśæeJį«Ó˜y)0ĮÕ+"q/{“s»kسd}1bćRŖōŗŪŖ*w¹ŠMįWlT³tbgī‹-łŃ U8Ź7P°¾²Z,ńóŹĀ¤±[2˜’u ‘£s4=fŖ­ņä@ķ)Ž„„*X‚}ȑ”^p4ī®X©_4ø‚PÅžuf„×1 é­"{L@„ō!ßėmKAŹd»½Œ§®`„£žu§WŠĒĀ’äĀĄM›ŸwŽńżPU%Żį%Ä÷”—Łī ų\$z¦eČ(™Ó uÄ(éLēšõ±”ŽAÆ“>ŁĄū:÷ŲęŁØĖQ‚N³fžLŅaÖ×ņBĻmßA—V »Ś®¶ü©÷-ͽāŠĪ×ümŌżĄO¶-«Ķ¦ū—KVų"óf‰© ~\w(}Ų–UT̃ ƒ0<>ūąŃ«­—²ßK—<ūĘiHœ0lŖśÄu¹VP”[Æ#Z–‰Eq£Ę\§8Ēö»7c]{$ü¬$÷1°ų5ųäŅf}ØVųĄ:Ėö²žz6Ā„2ü“"q¬ņV-mžY!UؘUŽP…į¤ĒQä@,0Łą8ßX”µėÜė ų§F,?`ZØł=Š=ŽuĘ^œ¦Lēbø>©^öŗĪė-6&čĘM‡ ő&bĮ––™ ń}ś˜J°-ļÄāoÉg«ÜÖ%.d.»­¢Ä^vHŁV”o¦R?MĆaŠ;y†°ōRƒ DŖiņĀv3”P oĀZ²oŲė•u®ŅŖöye;m>b2ø-Ī'GŸ¬h¦^P |,Y F·^OnW_C³ų‹24]›„²°ŽĻ/å äOŠ0YĖį)ÜjšĪR“N$„vÄaĄ/KįšŽŌ‚‘#§Ś„ß{1o¹+$ ,‡¾ł8ŠįӊmަFĀ3‚"fŗßč‘ļ›}•YĮ¢dŖx×ėm伍°Ÿŗum—)¹’5Öéżų*›Ū\ŁöUĆä&άWÖ>§P9>­¬[žš”øŅ2M|āv]®¼8-a»¹½ś)…ŖŒŠVŹčš¼b–ßīv ŸqMŽū·ąķ’#t+ŽāW}6JGŖ3Öčaņ†<{łŪ†åÄ“ÖL‘­.śøéa'Ž#-ńoœne[’śž×fńå/V“»XʆārūøĢö!d“™3‰ŗ3ŁlŚųiŸÜŁWjI^ć}Bś ńRuĶÜźĀ@Āģ¹ėéUfüĄŚ€ÖżHĮ5Č2,ūnõ{żš¬4‰ ŃyĘŚ9~ś„nŪ¤6­B“š æör<$±‚^žń¶ŚśĶ„Ц’-%ø$ZI­‚¢ˆ–P­„ódO«9¦;pżļ#ėą;DĶ›µKĮWi^ˆčב ?ØæŃB76åź¦V8ÓūE‚Xö³-CX“ŗ„±źß‚b;evƒ-yŒ2<ÆŽ é•_¹GÓ¾H ó>08åY^M¹żt"äč1ئ›ÄÅ'žėœŃ/Ž/:œž @”Čg”n1śT{$;VŚźQĖćžę/“2pźD‹„ƒ9łö „ūbLššŠIµ7E·žmÕ<ʛį]æD÷„ü6"ōnō»O–>įŌ›He„wŒ"®åx„ģēB颶ƒiÕ"™–€ž)„7;sUž /a”ˆd.®>ĈƒM'Ճ!ҁi½j@#PÉKÓģōīXKW!-{å’Ė5Ćē‡_"€§5‘€Æö‡·oģ¬O‹zįE–yŠ š«ģ~`Ę, }Ą¶Ÿ*ZäF}`įH®‡čČqņ ±hń p;ķÓ¦źįÜęµßŠ /†jĀoŗ{ÖÜ ‰ˆü¤Ž‰±öłošÕ¾µexį4·ŽĘĪE²‚ÄÉćšĮč¼k’-ŠŲ~6!8.&kNł[`rĆęĮ³”åŪž¬„5!Ž5eĪ“UY­2AĆć0-Pn»6é½MØ©ü^ń@‡ku”Óź­[9^K\c[ŪŽ<ā€ųKz$8SR]ĻΔɊQōķ’2 ĢXąĀRHõ-[óąa/ƒŠVĖ'.ƒ­z_–¾zB…nžrs—ČāĒŖšOIŁ`MmM (t£2ßą®Oмöż„įŠ©§q†Æ‚˜‹ERĢr²8ūķgȽ@•Ć‚äźhœÜę2|}ŽŃ#¼!ŚŽ pÕØ ŹŹ8Ņ·’¾}óĖ@ŒģÓžŚžwo9”Ž9Ņ“0&¼„ESbF]5óAļnÅP„“?²Ż:ˆ•:Øąn~C4u~¼ ‘’ŽŲÓa[KGź!źć‡×²Ńl¤8Š8GŪ –Ǥņ¬G-(?ĖĮųŌĄĆŽŪA7ö¾K†z=>FĆēo»™•q¦+Ą gŒ’‰(tۘČh.w‡Ńę\<īĀŌ@®ż‘ᛑaFY]+B“ŌlN—”Ufˆ£uCĻ¢zvūFDš$æ)‘¼ZÕōʚ¾Ģńā{_Ō¤³„bE/,Eµ+‰ł—ƙ»©Ž{sŪóQ+öFmHs”vśŌ4Ęź5¶­‡öūΐLŌ±%7x("—TL±Ćާ٫›ɤ­¢Š­×ö} pń^ĪÆælcĮ@äƒ7$•P'÷śu˜5Hó/nÓ3k S¹o3@ńóHA”ųĢłˆī²cµ©uņ^„¹Uh;±wÄEd¹VbgTµõd†š9å²M±ˆåe™ć/š:TōäRóAŹ!(Ąk偎=‚/9]±°M‡Ē8!ØAˆFo‹Å’Cćusń³³9±ą0†ņJģłóš]ēŗÕ䦱3hø¬ą8BčYXzŗļF na]ŸĀīĆŹœ”·kŏśūDŅ;æ86Ė+Ū“rgå>;Qjį–q8„^š?`_¼ÖŹł}Q(pq;–ē<µ¤Ü«„ļö×ō¢8Wø˜aĪ µ+8Š:Å/ŒgÖŚD†{āSuJĀ;F‚Uē7÷øä}•žĄ|„×Vą2üE_QŪćóŅ,ŽL0Čż«&#6±0Į”s+8‡_'ĢĀšäGžµ˜ó•?+bķöŘųˆ©W[ =Jß%"t™¾JÆpČʧīV ÉI«Ŗ*'~ļńuø<‹yLŲi’§’ļ÷O3āS‰p*“BŸ7ŃPŃ|Ćli+"hü¾;Ÿ{Ļļ9"¼xĀXlŁųÆū~]FWO”½H(Ÿ’3uąƒ„ėČ%.-Nh‚f›ź.©ÄŗŃpó‡p”āå–@Źf ±70Įz”:󣉒Eź«ņYėś"FĀŪCp–£™š_ņ7p~ŽŹĒ³š9(”ŲIĘĒłcā- j6ņ„Ķ—hIjŖÕ˜ķœ T1†łttvSŖa‹,ƒ(OŽOÜh <žÅā½g,oīk[„xp.kŲ¼čcņµ~ę;i£‚“ś­®jģ(’ĖāķY&Ӂüŗäcä›Įr”üLÕZj°`7xév‹ątQ܁ŅCxń{;ČYčo˜©¢)ńOHmµ·ŁĒłOIHN.Š‚7µ*²`LŠ"‘ž•€b.¢é$Öi«{ō‘ “ÕĖ@ćQŒz‹£.3x‚ĀpBņü³¹ō†ĢˆĢ<Ļ5?Čhź÷›ńóćz“ÅøŒ€÷Į?ŚIxD#ƒEšŠ%t÷Ś„æ$I²=xužęJ«›éŁøīŅŪP‡—=žĒē…m=y’Ø“:$æ³ķ*‰%Źāe>#ÉŲŖPńźŲ *ZœÜˆ ‹÷ēµČ˦·'|Śūæ5Ź—g¼C3z˜xŽh9Ųv:ؐø®ÅŽķĘŚÅ¬14$"–•M‰ąśHý‘Ō!@ćV÷Ÿ“£ ž(„p̬ņ<§Ī…ŒŌµ®įyń9[…D’¤ż*~ćÅPiŗū†‘—9u«+1ą¦Īų%ź^>µ}:ˆļ‘‡)O¤|\¤Ė+ćĶ4ÆA°–[š{ ƒķo”RėsƒóŽÆˆ¤s~Č?Ķ"qŻd>ž.Õ}ē”ļŲÖÜ„«Č±ąč¼W·y†‰³½ā±æud€ÉcRt˜¤ļė^gsvõ“<«Ļ¢ģŹe€£Ŗ‰*L="/u”“›J*£¦Ų&# <ŅÜē™9E¾rtL”“Ümj‹! 6ĶB¦(GjØeµåć»ŌÆwˆ(6įy£©hÓt_¤a X¼zžÜŅaަžŠĀG 9¹pϳĮ"Į©£[ÄøņBœ–śOQ0UŒscvĒæ+ńņ„1žÆ…µtŁ%”ƒ‹Ōķʝł"ēūó󯍡ZĖ|޹²Ł„XQF¢˜Ńē'5•ī¾› TŗinąEv¦až2^`BŽļ?l»¹W]20gĪŖ°˜¾•ž5ļ¹,A€øśxHš3ŚfĮÉ­ŽNæTĖĶĘVuŅD>yEuNČĒiŠ)&6MJø­éÄĘ8KšDVŽ;v6¹ÕóAü žFDDgš†;¬eä~HUĪHqčfŸ¼¶ū~’õh[²%ß©µ'L“¦ŻP*īģK#e©Sņc·ü§©©…ß’D-²œčŖŪŅ¢å#õqS?‚ö Mh˜vŚų¶£G®åĖ7ˆŃģ5%YŠŽ 9Ćn„9ŅŠÖõč0uQ,d3”?ÄÕī‡4M"$|„ņ$”YHę­ ŗcł&"Ąž Šß]ō{Ļł{ōåÜI¤śm3ÜK[śŻ#ŅŃ sD»‹“kXiBĬ„Œ"öĮh­a _`c/Ÿs懙“š4 kī±We©wRĒö*»ß{ļ Ū@8׿QCCE~iA,BĮļ“H-© Ä!ģļJliM,&ŪPj¶ßĘ£Khōx_鱅TŃÓAT‚恕_‘E¬ß,a&“Œ}4x8@Žēj19„:«L)nr–”4 <2īÉÉ·JF)Æī*™ŖŚbøX[Æŗ *«WlõjNęŌaų‰f©Šӄ;^®j6&“N—ū<Žźśē`0`ÉZVKBŲtrϊ cŁ hb–č+Ėć˜‹2IH‹·;ō’ĖH¹YEVŲdšiēę #'šģ½_¼±™…`W÷SŁĒŚöFµŌdŠDTĘė”f{÷ °u3Š€Ķ“Øétä¢®®’Yuš[0žŒ\čĘĀŪv|Ÿ%ŸĘaW•šĄöV Ś—¶%1ŁócwŅš0’JŸ>ž¾ą²¢šÖŸž8'rNƀęą~‰¬ł—Z§³ÉžŲµ¾&½¹ĒÉÓ%„±p^ßķ±oNź”wfé}%§ƒ™£Ė\ėģi–ķ é×ɘ܏0=ä–rZL˜LiÅZ‰Hż)8Ēļs[5-}<—Ń2»xx±n£Ś Œ{DL2RŽe^F–ĪAĆĮ3æų“ųmŽ7šGdčĶÖ1Č#’ó=÷Lé6Ŗœo€å–†˜pW/‰«%ö¾bö)GTQVˆącø€­ÄGyofjcEHLŠČVPēn3ŃŃs’ §ÅSšĻ2qłQ¹s•Ž„1Kć.9Ś’ ŗŪŽ2aīo~Ųߜ‘‚RīźŲF„Y¢u„r9Aż ™2 =™‹DcPO_Ņ%[_>C*öņœXŗŅĄQz‚ŗ÷½e×0āŌģuKq~„ŌŹz‰„LEP¬…²Õ«Ü]æ÷D6Śf-·É@‚i“«Ņz³CčcK]ŲŁ£~ś Ä(8Fģ"ā’[ˆ³Œ©q‡‹3&C^,īÆ‘ßżŁs4HjE;Īü"? ÄŃR\Į ©w³9wzmŸŻg¬źŠrjam!D eG0/˜ķ\o,§õ.ī.mQMŅĮšص’dfµ™ä±sŅUĘ-¤ŗ­Kčuļ{ĢeJŗĄL 2#īæ*„—±eļz—\ŌfŖ{ų«·v³‰äkÅ>SŹä ‹Łs#ņÄ3³ĆŅĻ-Ó„ÅõŽ>¢ż›,"{ĢL$dÜuĶł!-ųē 3ŹOAꃹrxaoi5©eöŒłiRŽ=b‘ŗ/†$«bu˧øąö§«:Ų: Q~Üģ*Hó.æ`Cwf‘CzŻÖösƧ°TŃĀ÷–X,ė²Ž­ā–¾Ó¾ŸüUJ‚6#ļŚæOĒŃWī 9]?ö.|zīT^ʧ¢ŒŪ„“)ųfRŠ#śŽ÷ %k3ė’B£Ļ˜œī"Ė}Øö:ö”sj¾uØ›yM]»æĮ8’Šēo°…Ī‚|łYQ×aßåQĻŖæŽįĶ æd€bX€Z}b“sŻ"”MČū÷³÷0tė4ķŒ:j$#¾ōöŲ”ĮĘķ²@õw>0 ‹YZgraph/data/graphExamples.rda0000644000175200017520000001564514516003535017113 0ustar00biocbuildbiocbuild‹ķ=ksÜʑX€’(]år•ø|u[.Wʹ$ŗ}rwż„dŹŽbYQ$KÖ%öIKrI®Ä—–Kńń‰ßó'ī§ģOŗ_Ż.Ń=źĢčĮ‚X–{z€mōō4zzzzVžÕŸ-Z–e[öüų’Īø8c’W²¬› cx}sŠŻßŗ{ÜŻŁßīŒ+~1ž÷/VÉłµtćģīŽśł 7Ē’&'•„.Vį¶ŅÖ¬c”‡—6°f [x©5/åĒöÖ7{÷ǜ’Ā{ģ9œÜ°4¹čZޟ{ąæüĄ²…KŚŌŻm²ƒO<dīØ×ßÜNīł‡üšÆž/ÉĆgŽ&|^‰™žĻ? Ń,’Ńē”Ü =ŸCöļóøč\qē%¾eyIż”3žSŠ ŻoŌʱӄ)˜ŸpµŅvßaśfÖ'õži“äß­÷6ŗ‡ŪĆāśģŚv÷`|ѾüQw8œ?,|óÜ~wķUw³4Īm“Ēt”ń‰]3~åm˜™9 ŸūĻłYx‡ÅAow½7ø·»±ē³`K ŪsRXųœw]œŁļ¤Fä%ASĪ/z‚8×é’’ėsÕY<Ü]ļzkĆŽŗ¤­!=Św‰O>*īóĒ<ø{_Ē°P'7Ī轓ß8o”)3Ņkj£™A³bq Só¬ōlˆ”9äā3=½Šżš}‚æ›}›ńūŗ˜õƾ„ĶĮ5 æ.įK*†’½č7Žęū½ž@S‡’ yē…WXŲĘĀv±°‡…},¼ĘĀ Xbį o°p„lcį §’uś@z;ēŃ9s?ųŸ+«›[;žqX‰„ˆÓõĄßüŻ’ų¬lHü.lį{&"§ZųyLϹę1įİ,ÉėcIn”œP.-V>"|"²|>ÜO™ł!&#ż’łB~xūqNšC½o2Ģz™¤a?Qśƒ|ž ź“Üo¦ō˜¼*łC}#ģŸ‹‚?Š/łż“ķØ»“‘tˆō»¬—(WŌKĆż™Œ'µsČ/ȕٮŠ|Ŗģ<.Ić)3Ÿs¤½ĖĘž^ņ‘ßJļ䞣Ęs3ņŗéWiö&śYę[¶;Č?Į7æ ‚_äSöŸäńŬݹįCöWtż9ŁNšÖKŠ_YŽhQ/ y²æĒČ/ņƒņ’ßc䃣Š¼ņūKõ#¾¼~&Że€ØgræÉü)ś‘‰ßŗ‹‘qMę_w\į—}yćūMĶCdž)?Ģģø³ŃWŹæ‘õAęw™•ÆŃļ”Ÿ…üČż‹rKŻÆ”ūß«HH,b‚dLŠ~—–‡bgvĪņŽŁ‚Bē 'užś;5Ƽe½V×# [–ųcYŲ®ĄG¬tKčR°Ńū„•^ŽčšĖ‹·?mˆ1ē«ų Ąę²KĢ Ó)č„īŸ–q*FĢbÄ$GLL–r‡ØE3żŻ!NRfĒÕ«ØpW^õ»=īķ¬ö{xćĮvƇZweü«ŖēĢĮQÆĢÆxč9{ĪnļH=åTMĒõś$ø“øGSęōyĀĪDwFŠ%|LĻį¶¢N$ą\ꕋjé9¶LŸM>Dą‰o)œœnčž<b„+F8r„ū-°sµ9Ü*ß]ļū{ØØW—#U ÷v‡½äķžßӊÜć:yœõźä§’õĆćĄ#E•’£ØśŻļ āŹųrC\^||r0ģķ”Ÿ¾£Łtī?~†Ō¾ļļöĻyĘ»ÜŪŽŽŪŻ’'ø=ō’PÅfĻ>ėł÷Ļūpūš¹¹Ś‰ōฟ:!OčõĒØ#;×®<S/ł,?0-DŁøUvUMrw~›óIīe„SĀuŠœńU“/[:¶p/ݦ˜‚ΦSrWάņUŠ)čt :N)}Lčžb–YĢ2s5Ė,bbELL'‘q–\(ō!ēID·6Q©ĖŌ–Ž)ļ\$U¾œéó]Kz>%—lłŗJn)Pń§č?&ž¢[ä•!_¼ņ¢ł”¶š™•Ļœ’äĆŌ{e)ž/Æą™Ņ”ļ;?qå2-~Ø-–YŪ›øļµ“‰æ9„=$¶ %~čži ꅇYx˜¤‡9S)Cžįl΃—ˆNčžøVX€Ā`…ē —¹H7_‹ĆńPy³y£ŗ?½šV¬°b¤{`ÅٜėóƊ³ŚO:)Ų]lŖ½ŗŠ„5l¬½Ž­µ{˜ŗio`{ķMl°½µ…„>6Ł~‰m¶_a£ķmlµ½ƒĶ¶w±Żö6ÜŽĒ–ŪÆ±éöŪn`ćķ!¶Ž>ÄęŪo°żöŃ–Ž1ToŸœ`éeąt…œU!gMˆĮYrpzBΆ„³)Dįl Y8}! 焐†óJˆĆŁņpv„@œ]!gOˆÄŁ2q^ ”8!ē@ˆÅ ¹8‡B0Ī!ēHˆĘ9²qN„pœÓSyH~ ™ō/” j‚N”Aq@@­"ŸIóĄ/~ š+€.Ā3Žü6ąwæų׀ ų]€ß@ż7€ ų·€’š?~š?!„śļއśū€šŌ?ü!ą’ ąqŽ<ųźAż#ø’\ ×ĆõĒŽu‹ĒųŠŌ“2@ŌE`;¶~gč ½ų`\żPéÅ ą+€ß<©žÜœŌĄeżų3ą\č‹ ėGŒč\'õźĶźĻ§äVJod»"ė‹Ź~gā$ÖaO¢¾Dō R/¢żų!ŌSśAŁŌJ?bė\7«ĖäYf²^PgŚÉöCqĘ _æŽvGŖś_Œ€Ėz@õÄ. >ņ`Ņ~vźyū½Mā.Dģ„āĢ6rüp‚T~5N}(ėé?׏Š'ŪĄyõĄÕ^)Ōõ3Ņś£*#µ PŪĻHł±õšŲś„ųȃ”>eėŸ~”\(ęŅ“øžF\?5®Ž(ĒĄQ(½1¦/.@¬y0¢/p?©7^½Å4ŸQ~‡ņ?tõ†²+Üś’tŽ»PWŅŚ6½ėäüī'ģŽÅ£?+±AŹM[qķ×¼Y鮚7Gō ź»]y0µŸ ×¹ć.@L[æØ8®^™ßbŪ'ĄW'żj؏§\„GģńĄ³ö‹€Ø2T5īee—”ćߙėą¤$ż%Ą#楓ž2^øi}I™øGŚSś’6®£\;ŽP5^%µ/ÓYų2u‚yÜq*­¾°łÓ©ų/źMÜõŲžĄHüźµżØĻZo’nH Ę„¤ńŁž$ÕöqpSq1>¹yÉ/¶xōę3¶ń‰šw™ņk“Ē'€Ić<©ēé•ćŅȃB?ą¾é®+|{^žT_ŠŽØōCŽ»A¤?Š“É[hj½q:ć =āöoUy ģž,@īł4źMÜq…mź§ćן3*{”ėĻRߌL:/N›ē’™P„?BoFŌÕ3q¹č¼ĒtޜlGŒ­D=I­ÉųBØ7¶N×§›GGĻ—eūR˜Vø×-e=’ē=I×%MĻsŲכĻFo:©ēĖqõ'®ŻŃTq·ÄśŒ§TęSTźŌOg]ˆĪ›‘ē91äˆG‘ķȓױŁęC€SćRĎøym]®óźŃēäiēÅrž.•ĒŪŽLź×&&Ķ“QĶ—ó½ż™ ÄēiŖĘøy¼ÜöE•ĻMĘŪB½n^§ö:ā#ę3Ÿ7ž:s`Z?E7ߏŌüH¬>m7’īD|äAŅÆ…ūĢęO}®ōWʹģIÜų½<ÅĪÓ<±ŸxbšøqŪH>ąÓŁē§µ'Y­óÄĶ{ŅŽG}’ĄŌł)pŻģxõG’ø§k/TūÓĪeæƒĖ>Ļėy0ń¼®g½Žw¼Įq&óõ`ĄćŽ/Üy’YļKĢ6Ÿū6ūś`R’DWTqYå|ą @Yobļk<³ż#p=Ÿq•Æs£O¦ņp]„gŌŽļĢĖ|I×Ņ>—źĶźWt’RŅ<—“ólU\/¶_øv\ Ūł€'ÖØO¼ źĶźžś÷z$×x—x’$ąqóRē×4½’\ŸœWųü&U>¦JoŅ®c³­/œÖųžŸź³×n“ėQŗóūiåG˜>w(é:„2ßź3óĖ”>ės‡€hģų”¬GŗėTŌz8› ų ąiēoģū#y0_ū–¾É,O<©’cś\€Ü偞ŲOr">ņ ŅA}^ņ’b~h„“K¦ę’IóvVŖōjźzxl  ”ü ķ|c®ó%tķW^WŚó3ó§GLōp+ėõ0ÕśFÜ|t*톋ŚÆ½Æ ©q(ółŌē%K7Ī÷\NŌ•?lEé—ż0•_!ūĖT~![|wäĮéęźē –ęķü`Sq.½Éśū ”½™NÜļŪž™øēäMŸŒ­sTž§P[ÆyP;ÆźĶźÕmˆÅĪ÷25O§ü2?Ē“‡±øņ“öY°łĶP?ķs’ī늫Oģy„€g‡Ź6®!>ņ`āŪõ¬äß7ÕÕŻż¢¦ż¶u-Ą•~@ņÜXØg;šiÅūtõ'i¼X•Gū{§ž\ųÖ—õD7æ"ń>š‘ó·Ńßg¬ė«ģ 5QßMN×h컸“ž“Ć~žąfõ%:›Æ•öÜrÓyĘÜ~nāõN€ļĒ~ćO] ¦œsłÅŗćVŚõ)öx@‘7 øj;päĮ„łÖ“÷S%]Š;_Ź:īĒ•Wń~~Ēߌ|OŅż2—.® øīž=ćēĆõéģWļ¤>_Pu^©®’ÄvĪ-ĄČŗąĘóæ&ןRž— ÄRŸ3©»OO5ž©üœĢģ ĄÄū=B½±s/ąśtżęŽ ÄŲņŽUē¤ūž<ą”ŽDā7”>³vSūn(<ķ:‡öyĶPæxR}Qķæ1~.ŌēĆ>EĻ×Iz.SŚļ±— ņ{5e}į²';N˜ž{ŗū(tķIŚż{SŪõ™Ļוß7ņź­¬ķ µ>Å=OK{n©ńq ¹? {Üī#õ o^ʗlyYæ­koŅźŪw*ó’æłƒŃyyŚxPŚļė©ō&uŽ2ąŖøPźsšB½ń¼ ØĻėy\ē¶sūŽ?ŠCg–—xģq ź§ūżµųū%Ź“®‹Rq›¬ó¾V&žw>ķżčÓń‹ćw$é÷˹āŹĘüfĄ#qfĄÓʗӼ•r(ŌĒÜ7l%Ö£Šż®'·”ŗXX…•Ö°f =¼“5›XŲĀK}¬y‰…WXŲĘĀv±°‡…},¼ĘĀ Xbį o°p„lcį §pŻÅ¦Ś««XZĆĘŚėŲZ»×ĆŅ¶×ŽÄŪ[[Xźc“ķ—Ųfū6ŚŽĘVŪ;Ųl{ŪmļaĆķ}l¹ż›n°ķö6ŽbėķCl¾żŪoaéųK''X:E8]!gUHĮYbpօœž„³!$įl Q8[BN_Ćy)¤į¼āp¶…<œ!gWHÄŁ"qö…Lœ×B(Ī@HÅ9bq†B.Ī”ŒóFHĘ9¢qŽ…lœ!ēō\:š~̾µJĪÆ½ņ•É»2±½–‡ĻIųü·'ļR Tm¾;VŗĆ®w}ß5¼>»9čīoyĆ.fżĄ«ŚŅ®Iųu _R1“8čķ®÷÷v7öb°tć- r%’ęó¾Y<Ü]ļzkĆŽŗd¾„&ęngo½ēS‹Jéü‘īŽ×c),É7€ŁõīńsTłŁ“½#YŻ;õ‘ÓĄ•¹½½ēkB”g'(*śÜjw¼6AńŚÕķžźųŽI¾±s§żĶąķT:톯u7C¤Ę÷NŖŌĀ«žövoÜģ}Æ©öĄ ÉŻ°,·„ SŠ)č\j:”ū/·É,¼…Ā[ ½…›Vī&B”!ž¦ōŹĻ¹^©WŲ0R‘‹ĒäĢ+WrŹ™š± <łZ~>±eāgåAž@HÉÅ,_Q9Éż¦ā‹—Ÿ¼Ńq„\$ża¢?§4óžäŽ¾“ž…|Sk£fä|ŌĻ“gC›įwÉbäŁe€iĻčĻś=D¹Ėļ£n.»tß®%ńKå”Äż2±ÖĻÄ÷u22€|Ė3L*w*{·ØŌݽƼć×ĶŲß”æBń©yvS;®jēŗP~ƒ¬MVž¢v-nN©—”:™oŹĻPåäņźķŪ'Ŗo‹›¶æ*}Ö=Ćnjżõż8Ō ä—ņŪŅ~‹…™’ˆ¼u÷ˆė~ŪL–æ)}Qń÷ģ ‰o&~£óOäåJłk*™W®sJæGę³ĪśüؐūWeĻTļóxęZ ~©y35_6旳ż*÷§ĀMžüŠżļU$ŖˆÉ1Y2&ūń{õ&L †³”Cqߏ%»÷”ė)ß7„©ų5Nėī¹Kxf—Å3>üRŒ»Ŗ³Ģ’ž]–¶Ż¼ķ½™:īŠķ¦ś÷+¢ŠLķą¢ćĻw“¾Ō|å‚żĖŪž‹ĢŠK:¦ŽoÕ š{d™ŚżäüŪo%lÖvNČ į™ĶŚ;Z~Ø7² łżó÷޲(ĒĖńŽ}ØŻnŌ‹h÷åö'ŌļW ü^Éļ]ń~y0r¼Xļ×ĶÄėāłņĖ~Y?PłÕŪŸę¢“ÜnČś ė?0{ŻłbŁēŹ+‰čƼn9äµÄ¦or>ŽŁyO|ū¢ŹWČ·}‰ļwéĪS-I>TŽĮÅš»ųōBs=uŹzĮfļ°Ż‰ķŽÅ°wéżJU¼Gwel:~%»žČö ±ŽäSOĢŁjœ¹žkörCż)ä–LnņYĶŁČ͜?#ūŸĄ“¶£æ(ł˜±CÉćq×kņ0¾Ī&µ7ē~™*žclü‚eŽ7že^nŽs.œ+ĻßużZŸejwķw{C÷Ł2ĢŁ2EnZ‘›FꦿŲ™©·źMæ\«‹ņrkĖĶj§ØoˆśFŪÆoUr Ėķjėgė•fMü Ł¬Š7+µ*–Bć224[ķT;qa¹%ž0f¢ķ—Eżlu¹^©śH«å·­]k~ŗ)šóV£ų…`°]_īųŒ·*~9XæģKÆŅl‰ßÖŚāžv„õcÉŌź¾X«@Łg»Ł¬ū«Ö|é5kžƒ«•Z€hĆē¢VÅņlµY[n‘V஀6Tüö%ćKĢoO£V÷·M×Wõ¢ æ'n·|&šĶC>”F„R÷‰¶‚Ģ“*ĄP„¶ģ—}™ŽéųŹSoūbYn·L™\ضƒH ßšM’¶VE¼3NÕW€FĒļ·z«P€NĶÆoW÷Ō³Óōł^°Ōj‡$éK R ¼K¾–ŒĖ¾¢wü7zņėŽøŅØ5[wŚŌø[~}ÕWŹJĒ×±f5 õķ€āVż7·ķæUć²O¹hO»x)Ū­ą•€lšĖ¾uhvü— 1~S‚­óĶCµģąŠø©Ó®ū7ł-’z¹y£ćwRĒ·!cRž[Ó¼5­NĄ|śelN=ßlźox3š€fąµōMČø\”F7Øu_2õe”ī“r3šĮÜøG«lšÆćrÓ@gŁŸZ!ā—;U_,JØ«Ņ®5}6ŖE „üžŻPHŠ‹N g£wŸ•Ž51uĀ©ƒ<ĄcÕå{žąO®ü9+ŸžŃ8µĮ©–|,ū€pÜ9Óó¹č”ܧ.'_%÷E™“ž-äüĶ'Ż”gxģüSÆÜæ²>'otĘżóæ—¹}3āsųł’'€æxq™ŪĶEĒ·krłÓ™ž įȃs9å:#ž!“§/ĪņŲ%棸čĢ 9āg<~‚žśŁųsĄŸĆ}ĻGylOŽčŲĀłÅŤOæb¦÷ōŒ“ž?kˆ.ļgóF§äžĢ*7.:Žš‡PÆ»/8łäÖėĖJ§Ä~ˆ*Ī£žŒxéāŌ÷g¼tq^÷‚U|żó].ł²Ż§ŠĶ%3bŸūą8ł-įēĶŲčńiRĀ£/rÖ?|ķćŽ/ćĘEž‡šµļogœķ+į¼6wķü‰¹Üó‰*+=G|īń,€¬ķ·E|öG—W˜éqū}˜Zƛņ“7:¶ˆO=9»Ģķ,a“MnØ?Œņ(·ś‡Lōń9Ü^{Ż®ĖI感Ńe£WfmÉu™éż†•ž-ā½/˜ł|ÄŚ/y£sŁż>[Ģ»åĖÜN>}ąõk¹ķ_¼ö'otøßė~†=gķäkÆ’\ĀĻŌ³ŃćŽ#q·—›æ;9—ļüķņó•w}Ė7=×KŁ×‹?b„ĒĒoœØ”žh‰Žļ™é=å±ųŚ÷Œµ}Üņ*ažPrz”ū‹Ķ'ž/ŠĶ'Åę”bóI±ł¤Ų|’§Ķ'8p;h‹“‘“ šsæśäb·ÓBνւĪ{C'tæ Å/,mai‘%ė’@ČTĶ<›graph/data/integrinMediatedCellAdhesion.rda0000644000175200017520000000535714516003535022041 0ustar00biocbuildbiocbuild‹ķ\[l\G>{Ī®÷ģęR·5„…ŗåÖ¤Łk;uĖ„g½vl7N²Z›(”/=¬×öŅĶījw­4ŅyH &/HˆĖKß*U!Šhā4Ŗ’¶€H}‚ q{ąŖJ‘PĢĢ™Ū?ēģ±½c;Ł…±t<óĻĢ÷’’ü3³słēœĀä©LśTŚ0 Ó0mōßBŃø‰žÅ £?…ĀŌģ±\vŗįÖWŒ˜uW 3Q­-–š(ŅžQ\Ćg¦'@ĪpӅ‰ /qbžFūfÜC·É2 ⼧ ,?vZˆ’^k•+åÖ9š˜UąTRŽÆj¤ƒŌHŖJžˆ*pö¼0ī Q•éb=ĖQÓ$£N††c4<¼]ĘCM¤įĆjŒ… >FĆģöš\ÓQ51UćĒXUnŠtĘi]‡U°ę{HÅš‰7ßĒÕ%ŲļEØē2Ę9Õ*ŅŖ9ŸPmEۘĪ'©äGT%+«ģ(Ļ+gTYUą„Z-&‘Õ•Ķk Ų%-g‚JĪŃpJ‘éL˜3©jÄ)e ŖŃ;ŠÉŚŪ™U5­«jĒ1iŖĮ“ŖŃrŖĄUk+.iv°«ŖIōvŻŠŪu£7¶ė¬óņ^mć^=é¶Ü6‡RńEœNFĒc[ßķ’8[*/Æ“ŒŽöÉ©‘©‘©‘©‘©‘©‘©‘łæŒvw£¶©‘ŁMH©Äc“D É{ą,Ž& ütœŠāTžŠāhž0ē꤀81Dz8ł·s‰FĢ!DĢ=qąocśū4,ŽŠ}l\4LsGAE=ÉY&”'|Iõ„ß ‰¢žšŲ(ź’Į˜n{”ģ—Ę%=įb؃¢ž|mcėyĀŻ@h`AŸ†ó„ūĮFXŲIL ¼O æE “ŠIAŠs„7Lķ0 •Į4šmųŅ#‰t “еaćą˜šĖ øj)õ.Lo‹ćĄ)æb@`U i¬©Ż/¶Ÿ"¬å—˜‡5J‘į¦I¢(Š1…IX'?_øl’Ø(ģN˜­ƒIŠ:˜” „€'&ågmh‚š %‘h˜r<č*²qp„üLĄ …3=ąD²qÜž¤õ"÷čoM yŁKKīj„ÕÜī Ē9&Š·‰ŁõC1n«ÕšyrįdŻ->į.—wĀcŁæī3«Œo¤ĖŽĮ>¬ŽķBŻd€¶×7Ö'r©o¤@ŗQŖ.–³Õ„šPĮ ˆ¬˜w¾m&“Ó.3^w`Ø"P…Ŗ¤üĢIįMŚŁ^,7JÅVi1Ü„—ö jĮ{Q¦Æ^—éo|^–{¶Ÿšży=ʹŅóūœĖ é—’HĆ?ŃšĻ4$Ķį\Żq ēņÆhžÆiųž–„/<-ėõÖ/§ōužvҐĖ|’mŁ&/®^oUd›¬½&ć^Ŗų¼)ÓÆ~S¦_ü+¤÷:_$mē\x†/Ӑ¶ŁŅVĪkĘyĘ(żJæDč_üĆńĆ·ŸņĆ’$ņ’Ü >ó½‡ez­)Ó×¾-Ó_ūŠLõ ™~:.ÓĻ~Ҧså6¢ē•¹ÜåßÉō+œ—p?üĮ];ÓĪó×Hśó?¢įIųź{Ių÷ŸŹ|.=GŅ/ĘŹ×y}ćR–±œņļ ö³$Ńyå)9ķ_$}ķž[–ń„!H'œ' ķ<éŠ0OĆĒiXźd:×>ē×ǹņs™÷wGaYųŠžųOš­×’ĒėˆŽ[<€Õ8D÷CӐ§es®H vw“4ÜźhcŹöɘ4ĀÓuŪż%ÜBZķ;ćCïАĀhk=°9ÅuÜGkbF,Cb™tnó€ĻŃ¢,"M[Œ3ė"±U‘µóŚļĒąš¬³öbėņł‘Æg_Æ9—z )•č£%BŽ*ßX“gėŗ8ܞŽ;r†˜^æĮ‡–{Ö£(÷č}z’f ©>Ž›š<½Z½ §FšŖ`õ5k«b›mŽC&¬beMćlĀJøä< ¦šDtĄøi«5½ė‚ƒœČššÅʁĄäjŅĒ /›ÄĖ—Jsw,jīVįHĻłCėrŻŽņ%„š˜*Ǿ(އU9&£8>ØŹŃŽā8®ŚL)Ņߌ7ÓC4bŽ*u¬]:BcÓ§°4č)Sē:ģŌAy­»'’e§–źøZźvčTZ©‹ćnr znč>깏)õx¼ķĮĒR8m <SÖć<Ę»k¦Ó¾ÅÅ%©ø÷Eˆó‡n@ڈ’4“XĪxW¤õøØŒņč 6MĢŲVƒ`Żī@Ļ»£tĪdxLy* „ė¬n†;#Y*Ļ?wE²ģtRĻļ‰ŌAy‚¹;’„Ņ c-±µ0›ö#8#::ūĮšg„ .ƀŚ(ÅJāė{Šs_dÄOĮ0)õ,<ŃsoŌįlDy€½?ŅDŹk§ iĖNĶ >vøėšÄR!¶¢)ʶ/!źĆ‘ųĢ6¢<ī‰låÓū£XŽ*°›“H” 0ō–\oÉ#>\Ņö<9ų©Ń®?”ÕHŌHŌHŌHżŅ±Fj¤F†v‚ģāŻ&ļĢöŲ;²›½ä~‰s×_Śģ‰×2õ«—źÆ^^ÆģĀ·(éŲ×7ˆŒ®æAt³ŽV !‚B‘WM™c@ńÖ-ęÅļ‚XB”RŪ”uĄµė=Owõ޹,o–ńuø¶ŠģśU9~x‹oH#'xeŪ¤Ļ.Ż¢ŗ‘÷·M*ˌŖ —Óm—¹·śŗČFgļvÆķ04²£=˜MKlöŸĪ¾Ņ³ÉWxĄguōŗPO–Ū[ūČĖÅųó&ōƒ$a®V\mĪłó+’f ,`7W?3=Wn¶˜č’GŃWósgraph/data/pancrCaIni.rda0000644000175200017520000000137214516003535016312 0ustar00biocbuildbiocbuild‹ķXKoŚ@6C"AUØŌGz(jBšRõP  ²!§•r]į A!ƲM«Jū£ū ’īīxmü( ®ŚK‰d<žf¾™ńī¢oˆ”ޜTn*’$儼L? Ō,ęéGN’ŖezÆŲČ;}4“¦R®š2ęŻ²ę&v©Q„ב5C¹öķķŃPk§āÉPō UųJŠqyq>84EūŅlC›’”Šī »łUóķBOQEK}åzōAü¬ŒN“ć„ņ½QĄéŖ°·®Z/ėõõ=pŃZä”ć?4Ż…m;ŲuȞŪ^ėµļØ6Ē?¼¹{ßj8ųanų^YŽōM4ų°©^)¶3ŸMo[‰xv›c<›5܅óaхĒęėtĆj°šüNŅ>[®Żŗ—} ¾{č!Ų½Hf>.eŻć'„ŅYd)>=‡ČŚÉu_-—_‡ŲXŸČZe§˜^zķ¬_µ™­jŽæļÆ_±•mņ‚Ų=ĶŗĀo³ŪŁé€^‡ėV\»Å ļō.ėb¼ĻJ<ūĒÄ’… ŲÓ_&±ŽĮFČl#Tä””‰”h26“?՟~®<ÕŪßńtrē„}6Ģ sĆÜ07ĢÕĢHūuĄ"v˜.!ˆ*sÄn)FČ$‡öAµ„@rŃhō’C»>‰€nBMF! ž9ĄĘy…̬C"“4(¦!ؐ˜C ŖˆU%¾“ĀŹFI &„Ó¦ˆPcŽń¶HŠņĀūBÄ×ģÖń±oÄō\PÄė¹ź<-IģŠßI÷'ÄŪÄ·h1óÜ?=fį\6ž!—„[—‘ē9|Fˆ—l4¾G˾5q}ɓ-³’BDēmÖ^-l·{–ŸV÷SN —«Ø8Ų2±3“nēa łXÉ䜚źuҜE91bāE–{Éš*eīTĆ!-cĖęŌĮc›æ9|ų£ß&O.6/ru®?³Céń)‚8‚©graph/inst/0000755000175200017520000000000014516033236013655 5ustar00biocbuildbiocbuildgraph/inst/GXL/0000755000175200017520000000000014516003535014306 5ustar00biocbuildbiocbuildgraph/inst/GXL/attributesExample.gxl0000644000175200017520000000226714516003535020533 0ustar00biocbuildbiocbuild main.c 555 1.234 true false test.c 225 316 127 1 2 true false 4.5 42 graph/inst/GXL/c2.gxl0000644000175200017520000000573314516003535015336 0ustar00biocbuildbiocbuild main carey max min a b 8 19 graph/inst/GXL/complexExample.gxl0000644000175200017520000000565114516003535020014 0ustar00biocbuildbiocbuild main max min a b 8 19 graph/inst/GXL/createGraphExamples.R0000644000175200017520000000035414516003535020357 0ustar00biocbuildbiocbuildgxlFiles <- 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/graphExample-01.gxl.gz0000644000175200017520000000046114516003535020275 0ustar00biocbuildbiocbuild‹¢`įCgraphExample-01.gxlŌ»nĆ ą=OŲ !·6QœLQ—Øs×ÄąK‹8_š„Ƒ+żƒ% ’§Ēū㫺±§q÷ŅÖ WbĪ‡ŪēÆŪ.<,¬Ö÷8Jxį}³“²m[‘?g…6ņóū,Ćā›JhÆy ƒu—¦`„Nx7ś:93:7•Õ&įZ—ΤŽō¢'uXźÄe˜”ćģDę dR £Œ2ÉLdJ óó&~†.£8˜­b3™·¤ļ15a£ŃøYsĢj4Ƴ&©³!Fę}4^ēƒä<[b½©9AABŃ£A ‚#©%AHļԊ Øk‚ FlʦP’ÖŻkńŖ”Ć]y˜ż s•RMgraph/inst/GXL/graphExample-02.gxl.gz0000644000175200017520000000041714516003535020277 0ustar00biocbuildbiocbuild‹¢`įCgraphExample-02.gxlÓ=Ā ąŻ_AŲń[cu2.ĘŁÕ¶M,T ­?_(e!5¹” åŽ'Ą%w8}«7j…6„’fd†OĒ :äß÷Ž}ČU„ń« ÖÖ{J»®#ySkEø —ū•ŗā”FøåŲŃĮźG] ’gø_ŻĪWŒĻE„øČp#y©Åӊ ‘®Ō 9lŅø;’Q€L Č| Č@Ę2 ÓžĻų÷†ŃK«Ź?Y•ō§FĢ<Œ˜EbĄ,£1šsVŃŲ`>³NŒ˜M4 ¼oŪÄ@ĪŁEÓĀ{Ąf ½\ųė§Ī2&ł8ł/('Eėgraph/inst/GXL/graphExample-03.gxl.gz0000644000175200017520000000033114516003535020273 0ustar00biocbuildbiocbuild‹¢`įCgraphExample-03.gxl‘=ƒ †w¹½PŚĶų15]Lē®Ö£j¢`«?æ€ŗŪ8÷>.J§¶!”ūZÉ8=Cš$*§&“‹ŲTö®Š”2¦ Ē‘–C§EĮīĻŒŁšÄ)§h¬ŗø:ļ*Rc ¾zÜ2 KŃ*1 k- #fcV¤¼‘/M¶vw˜×¦8ĄąoĘ=×3Č[«ÖHŒŚÜķØē²qņĪuuš3ļü§ŗ9±ePIš~½ĶbŹgraph/inst/GXL/graphExample-04.gxl.gz0000644000175200017520000000173514516003535020305 0ustar00biocbuildbiocbuild‹¢`įCgraphExample-04.gxl•ŚÉnŪ0…į}žĀš¾6©"ƒ «¢› ėnÓH±xЇXņÓ׉c8HŸ‹q|?X¹<¤ä‹ŽÜ·‹łą½Łlg«åķŠŽĢšžījp3iē×§ƒÓ»ĖķĒO·Ćén·¾‡Ćh²_oV£ŗ’śó0>½łĆŽģØŽÕĆż²›Ēõt0«o‡Ÿ?żžł04õ¤Y¬źęvø_Ö³Mó“kĪāL–§·>Åć×/Ē—ß~SóŌ<šŌ4 ęŌL@ĶŌĢ@Ķ Øy5sP³5KP³5kPój6 f jv fjŽAĶŌ“ ¦5Ē’×|lćĻ;DZīsAd»ūBІ >ļ¼åŽ Bƒ…J9#¼Dž,}DnĮ"‹¬ ²ŻC&ˆ$"ä‚H"B!hGPŸˆß¹Į "‰• ’ˆą”U„3ʈ"‡„5VIŸ5™(?krQ$֢ސŅ\ćÅ ¹yX£ÉŲ#„ŃxGŖĻF›0‹ćĖ–?8Ū8æl†iq€Łņg'˜mBęć³MČ|œa¶ ™CĢ6!‡qŠŁ&$*Ž1[~Z«Ł@‰Ź4¤śltüܵq”Ł%¤7Ī2»„UŽĆĢŽG²qšŁ%œlqœŁń›¤óĢŽß%mhv 9ŒĶ.!‡q¤Ł%$*Ī4 “ū8Ō<&¬WœjÖ+Ž5 w¢8×<&¬rlīDq²yLY// q¶ł„ŚļŌłÕē[8½üzÕĪļ®žÓ=,!graph/inst/GXL/graphExample-05.gxl.gz0000644000175200017520000000026314516003535020301 0ustar00biocbuildbiocbuild‹¢`įCgraphExample-05.gxlm1ƒ …w¹½PW#:5]Lē®MļŠ$ ±ųó‹H7‡K޽÷¾\®ķ·yb_ņ‹¶FBĶÆŠwkÕ65iXJͲ+ c®"ĘČÕź¼åHāžD /5Æ9„„ÖæÜČ4JČźq€*š-’„Õ öōtbR” *¦ų»'ĻYēŲņĮżQžčŖp łręgraph/inst/GXL/graphExample-06.gxl.gz0000644000175200017520000000040514516003535020300 0ustar00biocbuildbiocbuild‹¢`įCgraphExample-06.gxlÓ»‚0€įݧhŗŪŠ·NĘÅ8»[ B/Ö*<¾-……`r’ŅóÓIĒN6čĖķ»Ņ*Ć Yįc¾@Ń5©’ŸŖw8eøtΤ”¶mKÄĒXM§ēŪ…śį2! aŽaOkļ¦DĖpŗž.q&øŌŒgų£XełĆń("Q~Ō >\Ņńv¦)4% ©ĶŠŌ€¦4Š(@£4Æ’MXyß$V˰8äōdĒ”š1ėŃČh €ŁLL0ŪŃØhĄģ&¦˜żhL4圉ż£ ļ1_ü÷넪graph/inst/GXL/graphExample-07.gxl.gz0000644000175200017520000000052014516003535020277 0ustar00biocbuildbiocbuild‹¢`įCgraphExample-07.gxl•”ĶnĆ „ļy Ä=&$żāäTõõÜkR6ŽUĘuŌ§/Ų8bą` ³óķbψĶīĀ+ōŖ)„Č1Ķx·”Mq©ÖęA¦*»ŹńYėzMH×uYŃÖJf Čūēž˜āœf4cšaƒ:Vź3*YŽūÕĒŪ#`pÉ Ē­`„‚/ 1 Ā”zBµĀm“qߣ*…V2ÓģXEč¾A ˆžJ~,!BŲTuÜ 9š˜†Ż!²_¤R@VY·zÅč¤$wi9qČJ=ąrȕ‡¼÷;€>ŒØ34aźćˆ:‹{tš‹ż4҃ļišóĶŪ0¤Ń/>zæüz=· MJ7ƒ’ńi C<õņ÷é Ń×|Ł'N^łŲŠąį­æČģŻHÜåøż~ߎH>graph/inst/GXL/graphExample-08.gxl.gz0000644000175200017520000000066414516003535020311 0ustar00biocbuildbiocbuild‹¢`įCgraphExample-08.gxl•–ÉjĆ0†ļyŠA×¹^Ś,Ä ¤ ”ƒ›å*ÕŲr•Ę}ūŹ[{qŚ1Ų`3ß’3£±GšĪó$†O®2‘JŸŲōĢg=˜Fy<17˜ØĢŠ'Ÿœµ¾L,ėv»ŃčzQ)eÜZ7– ljS¦1ŅZ«N—3ę“ņéuµ!ĄYē”qŸ\%Šæk^)*‰4”RńØĻ°bB›Œź°ÕÄ[č§Nō‹Ō\±“>!Ųa'ēżp‹ F‰ł!b¶DŒ!b,“19S1%³#böDLEÄŌ’Ē -æÅ×ÉŚ¦šāt ōoˆzb‡1£ŁF‚až£Ąl £Ęņk‹Ą0ωĮĀ$“ńkKĮ0k fqB² šF!ēS•“Då¤Q9MćPš£*b@TN *§“SŹ4MDÉ77 19…•“Då¤å Š š&b÷Bõ@ŌvœbfO€˜>Iˆé“ 1}’PÉ i"ö/ü1i@LÉeˆ*y ˆ*yˆŖ^ ˆ©ž ķ4MDŗ\…€Ø— ˆ)¹R€˜’+ ˆ)¹Š1‹Š1‹JQĶM1ĶÕ =ƒ¦‰Øł‰Š! f"“D½*@̦5 ¦¹:DU/T=CćŁķ®?½Ÿ]«åŪuń:D6graph/inst/GXL/graphExample-10.gxl.gz0000644000175200017520000000027414516003535020277 0ustar00biocbuildbiocbuild‹¢`įCgraphExample-10.gxl1ƒ0 EwNyoRVD`Ŗŗ Ī])¶B$HP Ēotc`°dūæ7Ųe½Žū’›µ5r~‡ŗŹX©Ö”ˆÅbjꭓŠ{?B„øZ&g9’x¾Ć[ĪsŽ!Ŗ‡ėŚ©g%¤īõh€*-’„Å vŌyŚ]11JF{,Å{Ā|.0Ż/0tĘģS:nū—8Ve?¦Ķ xRgraph/inst/GXL/graphExample-11.gxl.gz0000644000175200017520000000032714516003535020277 0ustar00biocbuildbiocbuild‹¢`įCgraphExample-11.gxl‘±‚0†wŸār»­] …ÉøgWc+@KJ”čÓŪt0šthr¹’ū’ęæ¼\śfiĘV+ŽŒ°,v×K—ł>Uc˜86Ö„Ī9ROƒŃDHzŗTŌ‡{FV W7×\‡ZĮ1Nēc… E-{-$ĒI‰Öț•«±*ŹGѰے¾·?˜)™—Ą, Ģ#yžgB5‘aw£ūšy°ś«‹@ņé§āp+ŗ«Ų½^»“Īgraph/inst/GXL/graphExample-12.gxl.gz0000644000175200017520000003157514516003535020311 0ustar00biocbuildbiocbuild‹ą`įCgraphExample-12.gxl•½ĖĪWŅe9ƧHä¼3żÜĻ)Ō_5jō¤Šćž*Sw‰¤’wńé;ž‹|9 Ė ¤¤Ų ±lŪ¶ü"žĒ’śśę÷æ|žįż‡_޽ż·æ¦æż_’óæżåüōõ÷’žśß_^’õ퇒’öן?~üćæ’żļ_¾|łŪOŸžx’īoß’š÷’ē’ūßżĒ’+ż-żķūß’õ%ż/ķūļžųł/æ|’oż’÷’žß’ūÆłįūŸ~xóīūžķƟŽ~’Ėūžłń‡’Tü§äķė?ż‡ā»’ś—?’ķĶcž!óOń˜ļÅc~łQ<ę'ń˜ŸÅc~łU<ę7ń˜ßÅcވǼy'ó‡xĢæÄcŽ‹Ē|ł(óI<ę³xĢń˜Æā1ŠĒ|łN ŖšT5ŖjVÕ°ŖiUćŖęU ¬šX5²jfÕŠŖ©Uc«ęV ®š\5ŗjvÕšŖéUć«ęW °›`7Ān†Ż»)vcģęŲ ²›d7Źn–Ż0»ivćģęŁ “›h7Ņn¦ŻP»©vcķęŚ ¶›l7Ś’‡Łž÷żJżĖļß½ł÷ü—ļ.©śßu£É§ę{Æ)Ķ?„¦žšüÆÓ.óėō‹ęŸB3NĶž÷6/ó{[ł½„ć"śĮˆ6 ?ł?QŹŃ÷FT."õŪ«яF“iųłĮŸ©_DęeJć"R¦y©?Ó&ā—{\DęĻ”ÓEdŲĖł"2Där™g/׋Č<{¹]D?Ń&ā×ĻŽøˆŌ³7/"õģ­‹Č<{师̳WŅEdž½’/¢_ŒhńۃS/"ó:•v™×©ō‹H=åć"ROł¼ˆ~2¢u™§¼ŃÆF“‰ųŻæN5_D* ”‹ČŒF­‘yŹk»ˆĢS^ūEdF£Ž‹H½Nó"RÆÓŗˆ~¢¶‰xó €„‹Č¼ø-_Df[¹ˆĢ¶z"Z»ˆ ­_D†ˆ6."CD›‘zq×Eō»õMÄ[ODO‘yq{¾ˆĢ‹ŪĖEd^Ü^/"óāöv™·÷‹Č¼ø}\DfÜū¼ˆŌ‹».¢7B46ļ<#]DĘ#F¾ˆĢå"2DŒz"F»ˆ £_D†ˆ1."CĘ‘ńˆ±."ƒŃ¼a0šW"ŽŃ&āGx¹ˆ {³^DĘĀf»ˆ °³_DĘ÷済 ås^D†ņ¹."Cł:."CłJ‘”|]‰0”Æ+†ņu%ĀP¾®D¼3¢MÄæ<åk\DŖkš‘”|­‹HU@ĒqQ©źćH•A6ł¢2̦£\TŚtŌ‹ŹP›ŽvQlÓqĆ ˜Ž+ĘiÓqEƐ›ŽĶĘūż[Ō—ļpŃ_¾Ąa˜ļp ęūF…łžQŃa¾@T”˜ļ-ę{ļ„)jĢ÷ˆJW6QłŹĘJueć_JµŁųš¤/•¢7ŹĢ8Œ6óĆ£ĪüšĄ£Ļüš€Ž(4?<ą0Ķ8ŒJóĆ?ŒNóĆzĖ• Eo¹²”č-W6½åŹĘ{„Śl||Ą|4›0ÕęG7Rt›ų|”›ĢW“›LJŌ›LJō›LJœLJ4œLJ½²”&„^ŁP“RÆlØI©W6Ō¤“+”j³ńéĮ¤DŃłéóŃt~ņGaŠŖóÓę£ėüō`§DŁłéĮ¤DŪłéĮ¤DŻłéA"оóӃłŠĀóӃłźW6Ō|õ+j¾ś• 5_żŹ†šÆ~eCķ”~eć£Rm6>?˜Æ(>??ŲDŃ|~~0•Q}~~°‰¢ūüü`–£üüü`*£żüü`¾¢žüü`¾¢’üü`¾¢żü`¾Ę• 5_欆š”qeCķ”yeCMʼ²”6Ѽ²”ęk^Łų¤T›/¦2šŠ/ę+ŖŠ/ę+ŗŠ/&%ŹŠ/öW“”_ĢWŌ”_ĢWō”_ĢW¢_ĢW4¢_Ģ×ŗ²”ęk]ŁPóµ®l(ęוĻJµŁųś`§D/śÕ3Ÿ£żź3[Ž^ō«g>G/śÕ3Ÿ£żź™Ļы~õĢēčEæzęsō¢_=ó9zŃÆžł|\Ł0™-W6̤äteĆLJNW6Ģ&Źéʆ™Æœ®l˜łŹéŹĘ„Ślüé7QŽ^ōO?Ė9zŃ?Ģrō¢ś¤—£żóD/śēˆ^ōĻ½čŸ zŃ?8@ō¢>p€|eC9@¾²” _ŁPÆl(ČW6ĢÕ–Ė• ååŹ†É¢¹\ŁP¾Q®l˜,šĖ• åы~{0Ėы~óY4G/śķD/śķĮ,G/śķĮ,G/śķĮ,G/śķĮ,G/śķĮ,G/śķĮ,G/śķĮ,×+j–ė• 5ĖõʆšŹzeCmózeCĶr»²”f¹]ŁP³Ü®lØäŠ®l(hW6¾*Õfć»ļŽ(FO™Jьž2eQž2÷Cė*S–åč)s?M‘®2e:Qž2å:яž2e;Qž2å;”( é DmöJ”‰tP¢\¤ƒe#”( DÉ%ŹI(QV2@‰ņ’JžT2PņMÉ6%’ųĒ Šŗō”©¤}é)SĪ…é)SĪé)SĪ•é)SĪé)S„é)S­é)Sµé)Syd‚å%”(/™ DyÉ%ŹK(Q¦°@‰šīJŌt/PņJQ žóÉĻpGƒzŹ”+D…zŹ”+D‡zŹÜO6®«Ģżlćq•©Ÿš‹õ”©ŸoŒõ”©ŸpŒ"õ”3)Ѥž2c&å%ę"*(1ć]PbĘ» ÄŒw9@‰‰ %ć %J%ĘLJ%ĘLJ%&*”Jž”~†6jÕļŸ|&DōŖß?ųXˆÅź)S?³Ķź)3T¢Z=eźēv£[=eʃ¢\=eīg¬ĖU¦<(źÕS¦<(śÕS¦<(ƒhJ%Źŗ2(1§XÉ ÄħR@‰‰O„€åÆ”(- De%Ź( (QFY@‰2ŹJ”QPāƓ*ŠĀõ‡ŸjS¢qżįĮŪ”Ø\xšŁ6%:×S¦œ2J×S¦œ2Z×S¦œ2j×S¦œ2z×S¦œ2Š×S¦œ2š×S¦œ²å” ”(§l D9e%Ź)(QNŁ@‰rŹJ”S6P¢’h%Ź`(QŪA‰2ŲJ”ĮvP¢ ¶ƒ•D;(Q×péĄÄły'ĪĻ;@ł^yet°?>ų±ģ>D¬DūćƒĻ+ŃĮž2õg‹öĒ@V¢ƒ=ej}D{ŹŌśˆö”©õģ)Sė#:ŲS¦ }€eč”(CŸ Dś%ęĶ‹2A‰Ś”(CŸ Dś%Ź™'(Q;A‰²Ų J”ÅNPā,ogy œü |!j؟|4a‰ö”)«Œö”¹'„]eī9éW™{JĘU¦¬2ZŲS¦OģøŹLö­ŃĀž2c•õ%Ę*ėJŒUÖ”«¬(1VYPb¬² ÄDęz€ć°õ%&ūÖJŒĆÖJLö­ ”c® ”c® ”Ø0Z0QĪ\8QĪ\@QĪ\HłQ}Ą^4±??ų`ÖMģĻ>šµF{ŹŌ“Mģ)SĻe4±??ųT×Mģ)SŸ:Mģ)SŸ;Mģ)SŽMģ)SŸ=Mģ)SŽžA‰rōJ”£P¢¬¹€å±”(- Dyl%Źc (QfY@‰2ĖJLŠ­…^¢Ģ¤ŅL”›Tŗ‰²“ PœĒVś‰2”JCQŽmģ/>`ŗFū˃O‹®ŃĘžņąó¢k“±æ<ųÄčmģ/>3ŗF{ŹŌ3mģ/>lŗF{Ź”ÉF{Ź”ÉF{Ź”É6P¢L¶›(QŽÜ@‰ŠĶ ”(oī Dys%Ź›;(Qł·ƒeé”(Kļ DYz%ĪŅ;0q–ŽĮ‰‹Ķ 8K ÅYś*ĪŅXłŁ}:õ†å×_¬‚(d}šył5 Ł_|Ž}Böןd_£=eW™{&×Uę>éūøŹŌ*ˆBö”)OBö”)OŸ D¹ģ%*8OPbzÜ:A‰rŁ J”ĖNP¢\v‚e— ”8»\ĄÄ%ŁNœ].€ālog{ Ø8Ū[`å5­QŹžöąK+j”²æ=ųڊ„ģo¾ø¢E){ŹĢk×¢”żķĮ7^“(e{š-JŁß|ėE‹Rö”©ÜRö·_—Ń¢”żķĮf“”øÆb%&Ž·”˜UŠ(1»%PbVAK Ä¬‚–@‰Éé-“Ó[%fƒ“JĢi ”˜ĄŻ(1¤%P¢6HĖĄDī–Į‰Ś<-µyZ)*Ø· TŌĘj¬ØÕ2`Q«eŠ¢6VĖĄåWåaŃĢžžąkZ4³æ?ųāŸĶģ)sß“Æ2ÅJ4³§L”ĶģᄄE3ūūƒÆjŃĢžžąK€Z4³æ?ł hfO™Ś=”˜{¢UP¢–H%j‰TP¢–H%ę i”ØŻSA‰Ś=”ØŻSA‰¹^Z%jeUP¢VV%ne5`āVV'ne5ډņ“RÜźi@Å­žVÜźi€Å­žZÜźiĄå7åaŃξyņefŃξyņufŃξyņ5cŃξyōEcõ*S/]“³§L½ŃξyņucQξyš…c-ŗŁS¦˜ØfO™Ś=”˜÷'Ś%ź\ DmŗJŌ¦ DķžJŌī DķžJŌ D-‘Jœ©O`āī NÜ2˜“å'“~¢ eŅP”£L°ā–Į,nLŠā–Aō³oß>põčgß>ų&ĆżģŪßeŲ¢ž}ūąŪ [“³o|Ÿa‹röķƒ/'lŃ;}šõ„-ŖŁSę¾²²_ejD1{ŹŌ2X D-ƒJĢ2č(1Ė  Ä,ƒ~€sæō”˜ŅPb–A?@‰9DśJTÄļ0Q.Ūp¢\¶E¹lO E¹lO@E¹lO`E¹lO€å×ķ»_Ś£ =eź{f£ }÷ą{E{“§L}Am“ļ|!i‚ö݃oķŃϾ{šż¢=źŁw¾a“G;ūīĮwŒö(gß=ųĀŠžA‰1õžA‰rē J”;gP¢Ü9ƒ“¹{%Źf (Q6[@‰Éܽ€ēĪ˜Ø¬Ž 8QY½€¢²z/ Åm‘TÜ)`Åm‘XÜ© Åm‘ \Ü©ąåwõe֕¶¢|„ŅW”±DGūǃ/īŃў2Egt“§LĮķ)sߐ¾®2÷éĒU¦ČŒŠö”)0£”=eŠĖ(hO™Ā2śŁS¦(i Äܽµµ(Q[«µµ(1o„ōJŌ)ŅA‰:E:(Q«µƒµZ;(1uVļ D­ÖJŌ{"½·Z;8q«µ·ZHq+r·"Xq+r·"hq+r·"xq+r€·"xy§Ü/jŚ=ų ō-ķ)STGI{ŹŌŃў2ÅtT“§L! ķ)SDGA{ŹŠŃĻž2ÅsŌ³§Lįķģ)S4OP¢`^ D±¼@‰ByµČ(Q‹|µČ(Q‹|µČ(Q‹|uµ.Pb6ņ8@‰Z­ć&jµŽœØÕ:€¢Vė8@ŠŗZĒTŌJXQ«u€E­Öq€µZĒ\Ōj‰®ble$ڊń•‘č+ĘXFt“ļßūÕ:¢¢=eęŲQў2uT“§L±ķ)ShFE{ŹĢjQў2tT“§Lqķ)SXFE{ŹĢŽ”(˜3(Q,gP¢PĪ Ä,»‘A‰Yv#ƒ³ģF%fŁJĢÕ: (1;rP¢vd%ęj”øÕZ€‰*’G'nE€āVd)nE ¢®ÖQĮŠ[­°øYA‹[‘øØėsTšāVk/nµVšāVk/’2”}DGūįƃ•ķ)SÓķ)S+9:ŚS¦f(:ŚS¦F(:ŚS¦&(:ŚS¦(:ŚS¦ę':ŚS¦’it“§LM]%jč(Q³ÓA‰JŌätP¢§ƒ:(Q ƒ:(Q ƒ:(1µõč Då†JTn Då†J\nĄÄå†NÜ)?ŠĖ¤ø¼1€ŠŪ’¬øż?‹Ū’“øż?‹Ū’¼ø=>Į‹Ūć¼¼W~ķĒöt“§LQķ)SPGG{ŹŌFŽŽö”©ķ)SDGG{ŹŌFŽŽö”©9ˆŽö”)œ££=eŠęJŌF^ DĶĄ%j(Q°@‰ŁČó%f#Ļ”˜<Pb6ņ<@‰ŁČó%f#Ļ”˜<Pb6ņ<@‰Ś¬ó&j³ĪœØ’|&€¢6ņL Em䙀Šjf+Ŗ˜ °Ø0hQåśLĄE%‡™Ą‹J3•f/Ŗ˜¼Ø03xł Œ,ZŚOŸ|˜ŃŅž25}ŃŅž25|ŃŅž25{ŃŅž25zŃŅž25yŃŅž25xŃŅž25?ŃŅž25>ŃŅž25=”˜Ų= (Q3W@‰¹JLޘ”˜ą0 (QóV@‰ ”ØąPA‰ ”ØąPA‰J”ØPA‰ŗÉg&.9Tpā’C(.9Tā’C*.94°ā@,n“7Šā6y£©(Wite+¶¢|„·ÉxQ·üląÅ%€Øi?~¢¦=ejŠ¢¦=ejˆ¢¦=ej†¢¦=ej„¢¦=ej'GM{ŹŌ DM{ŹĻQӞ2…sŌ“§LŃÕA‰‚k€µī(Q h€u¹P¢öÖ%jo PāöĻ&n’ pāöĻ(n’ āöĻ*n’L°ā.Š XÜŽš Åķ­ \Tw='xqūn‚·ļ&xq—ė/nONšāöä/nO.šāöä/•—EWūå˃ż]ķ)S.]ķ)S&]ķ)S]ķ)S£]ķ)S“]ķ)3»¢«=ef^Wtµ§ĢŒėŠ®ö”™i](1ĆŗPbfu ÄŒź:@‰™Ōu€3Øė%fN×J̘®JĢ…½(1öJ Äœ•@‰ 8+pV%&ą¬JŌa¾0QĮh%p¢‚ŃJE£•AŠ F+ŒV+ŖŅ_°Ø@µ2hQjeą¢ÕŹąEŖ•Į‹ T+ƒŒV/*­^T0Z¼Ø`“ xQĮhš¢‚Ń*ąE£}ķׯ>­čkO™r‰čkO™ŚčkO™šŁčkO™ŁčkO™šŲčkO™ŲčkO™š×čkO™×čkO™ F”Øa­ DĶj%jT+(QWA‰œJTTi DE•JTTi DE•JTTi DE•J\TiĄÄE•N\TiÅE•R\Té@ÅE•V\Té€ÅE•Z\TéĄÅE•^\TéąÅE•^T÷³:xqg€qxqg€qxqg€qxqg€—OŹŖxł¬¼z€—/ʬ£³żóĻ™**ŪS¦Ü,ŪS¦Ģ, ŪS¦<)śŚS¦,)źŚS¦)ŚŚS¦ )ŹŚS¦|%ŗŚS¦l%ŖŚS¦\e‚e* ”(OY DYŹ%Ź(Qʰ@‰ņ…J”-,P¢\ae ”Ø(¶@‰‰bé8€‰ŹT/!ķÄųÉKTT:z i)ĘS^BšŠq•—¶b|å%2*鼄€FE—ŲØ¬óvŅ‘@ŽJ;/!-ĘxĢKrTny AŽ ./!Ę8ĶKH«1^óŅlŒŪ¼„“ć7/!Čłjnʗp“óķ›o’ŅMī©3łå„KW3œhrOó›hrOI>/]½źœME“{źœKE“{źœ×D“{źœÕD“{źœÓdšāü¢€“d^:šāl¦€g¼˜0óҁē1¼8§(ąÅĶ{/&™¼tąÅE“BqSŒĢ4ÄØ¢č%¤Å8©ōg2•&ć\¦ŅeœĶT`#ĆP72 U€#ĆP92 5#ĆP92 5£ŗŸ—äČÕ@ŽLQ äČÕ@ŽLQ äČLÓ@ŽĢ4 äüéL.:ßļ^.õ E黅.ÖDė»…Īs¢öŻBē9Ńūn”³Ž(~·ŠYG4æ[č¬#Ŗß-tŻļ:ˆņw  ’ć`ēƒä8$Ē9Ą 9. ’ć¬cw€ ’ćbÕ 9άÉqf5IŽ3«Ir\$›$Gf²Itd¶šdG†«Ixdŗš¤GĘ«I|d¾šäG¬I€dĀZ$HF¬E„dĘZdH†¬E†dXZdH†žE†dźYdHʞE†d{“n<șк1!åBéøq!eC)*ä¼4ß„ؐ·Pe¦ņ*+IQ!o”r’ņ*#IQ!o”ņ‘ņ*IQ!o”r‘ņ*+HQ!o”r‚”HŽ [)‘å )‘e )‘å)‘•™R"9ŹwR"9*ś¤Dr”ė¤Drœéd’ć<'“}R&9.ś¤Lt\•2Łq”)eĀ殞K™ōøø•2ńqq+eņćāVŹČÅ­TH M©!šR!C.4„B†\hJ… ¹j*2äāV*dČÅ­TȐ‹[©!õ·Œ^J2ä‚ZŖdȵTɐ{Ÿ/U2ä"^ŖdHµJ†¾“ęuó?_Öå{±uó:ӌŗy gFݼ…Ī2£nŽBē˜Q7o”3ĢØ›·ŠłeŌĶ[čģ2źę-tžuó:Ėk$ĒłV#9ζÉQ…Zj$ĒŁ]#9Īķ:Éq–ÕIŽs¬Nrœķt’ć2^'9Ī®śē8Óé7¦ć\§ßøŽ³~c;Īwśļ8ćÄG®A~dąČõ[iÜx3Ÿqc>Ī}’k!ø’k!÷n`dHFµI†dT›dHFµI†dT›dHʦI†d36ɐ \“ }sgź$C’ō÷/zÕ¢ŽB÷+Fż¼…Ī3£}ŽBg™Q>o”sĢčž·ŠEµØž·Š9m4Ļ[čŒ6Šē-t>½ó:›]$Ēyå"9Ź*óAr”Sęƒä(»ĖÉQž•’£,+$GEµ|euł 9ŹÆņAr\āŹŃqv•²ćWN„Ē%®œHK\9WŽåD~\āŹ‰¹Ä• r‰+'"äWNdČ%®œČK\9‘!—ør&C.qåL†\nŹłĘ‚œår&”oLȹP&C®āŹ™ ¹¬–3r‰+g2äWĪdH–c¹"Ör!E’”ö-ō/óņ9/G ½…ņ7[!”æÕ”³Ūh ·Š¹mŠ[ØāZŽžy ×Fż¼…ź}ˆķó:§ņy ŃV’ć|¶’g–•äøøVIŽ3ŁJrœĒV’ć,¶’ē“•ä8›l$ǹd#9Ī$Ūē8Ói7¦ć\§ŻøŽ³Fxd@l¤GÄF|d@läĒ•y¹ -; rļžęN„d“ģdHFĖN†d“ģdHFĖN†d“ģdHFĖN†\™—;’”““!-’Ńr!-’Ńr!WęA†d(dH†ŅA†l(„Č&ĖØ”|y׃€-ōŗ_1Jč-tFō:· z ŁF½…. F½…Īj£ŽBē—Q?o”³ĖhŸ·Š¹å$9Ī,'Éq^¹H޳ŹErœS.’ćŒr‘ē“‹ä8³[$ĒyŻ"9ĪźÉqN·n<Ǚκ1å:åøqe;å <.–ƒōø|Xāćņa9ČĖ‡å @.–ƒ¹|X"äņa9Ȑˇå C.–D†\>,‰ ¹|Xrł°$2äņaIdȕ–%‘!—K"C.–D†\V+‰ ÉÄU!’5`ɤH†µ’‰Ń÷ŅÅ¢ˆžéå$¾A,ŃCo”üĶVåoµAčü6Jč-tvō:· z ŁF½…*Y–čŸ·Š™t“Ļ[č<ŗgхä8‡.$Ēt!9Īe Éq†WHŽ ˆ„g”…ä8Ÿ¬$G%ĖRIŽJ–„ŽxŽ3Jt¤»V²#͵魕ōȄX‰Lˆ•üȄX Lˆ¹7§K#B2[62$³e#C2[62$³e#C2[62$b#C2!62$s^#C2ēu2$s^'C®, ¹°t2$³e'C®, Ł|Ų ‘͇ż M¬£„‹Eżó˃¤Ņ(¢·Šķ‡č”·Š=·QCo”{f£…ŽB÷¼F ½…īYz Żjˆ z Żfˆz Żbˆśy Ż^$Ē™ū$9ī†Ÿ$Ēō$9Ο'Éqü$9Ī×'Éq¶>IŽsõIrœ©O’ć<}’gé‹ä8G_$GęąEtd^dG.‘ExäY¤G®E|äYäGęąE€d^$Čåąz!—ƒėA†\®r9ødČåąz!—ƒėA†\ĒZ2ät=ȐKŠõ C®c­rŁ»&2䎽Ɖ ¹Ō^r©½&2äR{MdČ„öšČKķ5‘!—Śk"C²K®‰ÉĄ_)’æfb$ĶäHžš ŅOĪÆkŃæ¼ÜÖß 5Šč-T;“F½…īe‰"z å3; ”Ļė„P>« BµkŃ[čv`Ń[čYŃ[čöX!9n’ćvQ!9n’ć6Q!9n’ćöP!9n U’ć|½’gĪ•äHo®DĒšZɎ4õJx¤§×ßqĘSoŒĒ9O½qg=•ÉŻH ƍÉ0ÜȐ ¦ É`ŚČ ¦ ÉxŁČ ‰ ɐŲȐ ‰ ɐŲɐ ‰żĘ†œõ;rFŌļŒČ9Qæs"gEِŲɑMz żģNó]ōÆÆĆśA֋&z ŻSMōŗ'(šč-tŽMōŗē5šč-tĻj4Ń[čŒ:šč-tuG4Ń[č >šč-tYog҃ä8ž$ĒE¶Irœ·O’ć"Ū$9n'L’ćVĀ$9n#L’ćĢy’i°“čHdGF½Ex¤».Ņ#ĶuŲł‘½ē"@2ź-$£Ž"B²÷\dHöž‹ Éx¹Č‹—ķ C.^¶ƒ ¹Ž³dČÓvÜx2”vܘr”vÜø²”v!LŪA†\0mrĮ“dHӖ‘ ¦-‘"Ł^¶DŒd0m‰Éö²%‚$3mK$IfŚ–ˆŅ/Īw[“Ņæ½\ÓĒįōŹfAč^–裷н(ŃFo”{I¢‹ŽB÷‚D½…īåˆ&z ÕlŃDo”Z‚-šč-TūØe’ćVC&9Īß3ÉQį“’ćܽg“…äH·,DGše!;Ņ+ į‘VYHtŹB|¤Qņ#}² i“•¹xŚ*rń“U2äāi«dČÅÓVɐ‹§­’!O[%C2šU2äŽčn• ÉĄWɐ | ÉĄ×nlČłP#C2š52d_#D6š5R$›Čֈ‘ |ŁĄ×’ |$ŁĄ×‰’ |,ż*­,Źéß_FōŸH8aŠįÅō:¢–ŽB· £”ŽBĒPTŅ[čŠBz ?QHo”£' é-tģD!½…ŽœArÜ$Ē­ĄArÜ$Ē­±Ar\É2HŽ ҃上e·p'Éqūv’·4'Éq;s’·ų&ɑĖk¹»&Ł‘Ń}ŽŲŽóyć;Īxęń8ēY7Īć¬gŻXóžE‚dŒ^DH†įE†dćŗČl\’ė"C2€/2$ų"C®«ķrѽ7&¤\Ø7.¤lØdČE÷~!ŻūA†dtļĒ)'ź)’ł»ÄHęļ~#™æ{"H2÷D’džī‰(ÉüŻYśĶu =zé7oŽ¢‘~÷ņŸæGōŃ[č^˜č£·P-—}ōŹe@(_’ ”Ś,#śč-tÆdōŃ[Øöʈ>z ŃGo”Ś*#“µTF&9j§ŒLrŌJ™ä؍22Éq %“·O2ÉQ1z’ćöP!9n ’ć¶P!9n ’#wP!:r²#7P!<.FBzäž)ÄG®ŸJ~\Œ•ɽUI‹Ń£!¹š*r³zT2äųØdČšQɐ+²G%C.ŗJ†\t ¹č>’ѽ‘!Żr e42$C#C2ō72$C#C2ō72dC#D6ōwR$’łčÄČŽ Ł{”$łĪÄč$ɞ(ŁS£“%łĪÄč„É^)4Ł+„“¦7ҵiz+m;Ŗé?^¦ėßŌQMo”C?Ŗé-tąG5½…ūئ·ŠAÕō:䣚ŽBGmTÓ[蘍jz ±QMo”ću’Gė$9ŽÕIr\˜$ĒŒIr\¾˜$ĒŋIr\ŗ˜$Ē…‹Ir\¶X$ĒE‹Er\²X$Ē‹Er\®X$GnųEtä‚_dGī÷Exäz_¤Gn÷E|܆žłq zČķēy ·žēA„ÜvžrĖydČ]Fó Cī2šr—Ń<Ȑ»ŒęA†Üe4r—ŃL7&¤\h¦R64Ӎ )š‰ ¹ūf&2$ļ›™‘¼of"Eņ¾™‰Éūf&r$ļ›™ ’¼of&Iņ¾™™(Éūff²$”™ “üėS3“&y¤ĢLšŽ¹†hFEżÆ—‹ł#eFE½…ŽßØØ·ŠŃõ:v£¢ŽBGnTŌ[čøŠz µQQo”c6ź-t ? ź-tØ’ć@/$Ēå„BrÜ|T’ćRB%9.$T’ć2B%9."T’ćB%9. T’£Ž”YIŽ‹•äøtPIŽ äølŠHŽŒčČõŽČŽÜīšČåŽHÜķųČÕŽČÜģÉ»Ø‘  :’‰ “!yQu2$£D'C2It2$/ŖN†äEÕɐ¼Ø:’U'Cņ¢źdH^Tƒ ¹÷šę CņdHŽbƒ É[l!y‹ 2dŖAˆģA5H‘=Ø1²Õ Gö*šÉ^E“$Éw}ę$Jö šdÉT“0É7Œę$Mö›¤I¾a4'i²gÜ$MH÷’śżĖ;rQRo”›š(©·ŠĶL”Ō[č&&Jź-t!%Jź-tƒõŗY‰Šz ݤDC½…nN¢ ŽB7%‹äØYÉQ²’£ęc$GMĒ:HŽŠ ė 9jׯƒäØUæ’£6ż:HŽZōė 9īČYĒé(×YéĘu”ķ¬tc;ŹwV"=nß®D|ÜĪ\‰üø•¹rs%ä¶ŽJDČ-½•ȐŪy+‘!·ņV&CīąX™ ¹ƒce2äޕɐ;8V¾ń gBłĘ„œ e2äΆ•É;V¾ó!gDłĪˆœ•;'rVTī¬ČyQ!GņnXå&¹²f•›$-°%yr¬r“…¤ –›4$]°Üä!w7¬r“ˆ¤ƒÖ›L$-“ޤ"锕4żKZa4Õ^Fęß9ZŃTo”øhŖ·Š[4Õ[č†-šź-t£Mõ:䣩ŽB—¢©ŽB7)ŃTo”›“(Ŗ·Š”ŽH޽‘‡y#9ņFrÜŗo$ĒķģFrÜām$ĒÅ’NrÜĀī$ĒķėNrTĖ·śē8ÓéDG.ÜNvä¾ķ„G®ŪNzä¶ķ7Ę㜧ß8³žA€äŖ$HnŚqc>Ī}’gĆ CrW2$Ć’ C2ü2$Ć’ C2Ā2$#ü$C®ł_“ Ł? ‘Mš“Ł?‰‘Mš“Ł> ’į“$Ł,=‰’ĶŅ“,Ł,½“ĶŅ‹4Ł,½H“ģą×"M6†/Ņō^VŃQ|yʃõŗ‹Žz ŻøEG½…nŲ¢£ŽB3jłˆŽz Ķ ½„ B3f/a†Šģߗ°@h¦ó%¬š{ IŽƗä˜įz IŽ­—ä˜Ķū’³>ó‘HŽIš/!É1 ž%$9f_æ„$Ē,Ż—äØ žRµ­_J²£–õKIxŌ®~)IZÕ/%ńQį?™üØEżR µ1_J¤ęKI„Ō¾|)ɐZ—/%RŪņ„$CjY¾”dHEų—’ ©’RŽXó rćAĪ„Ź 9*dH…’—ņʆœ•;rFT‘ ’/))rį’%%F.üæ¤äČÕ÷/)ArwC>ź9;ŖDÉż”—”,¹ę’%½ICźZyII“»V^RŅ䮕—”4¹kå%%MīZyII“»V^RŅ䮕|4Ņ䮕—”4}Mõ§—źCē%,ŗ¬Mõ:k‰¦z ±DS½…ĪV¢©ŽB7£ŃTo”³hŖ·Š Y4Õ[čę$šź-tSŅI޽“‡y'9ņNr\Źč$Ē…ŒNr\Ęč$ĒEŒNrÜ”3HŽ ƒäČ|1ˆŽäŒØÜ‘s¢rēDĪŠŹ9/*w^äĢØ$y\•r“ƒ¤©¢$ß-+…,É»¬Ā$ļ²RH“|·¬TŅ$OŗRI“<éJ%Mņ¤+•4ɓ®TŅ$’īc©¤I^ƒ„’&y –zēLΚ*i’wY©¤é«ė©Jt×ß¾}{pŅ•Ø®·ŠYZ4×[č -Šė-tv½õ:3‹Śz ]°ŠÖz Fi½…ĪĘ¢³ŽBgbQYo”³°Nrœu’ćģ«“ē@ä8’é$ǹO'9Ī{:ÉqĪÓIŽ‹aäøÖIŽsŗArœĻ ’ć\nw}’#Cß :2ó ²#sŪ <2¶ Ņ#oČA|dŽäGƽI€dŚ›$H†½I„d֛dHF½I†dŅ›dH½I†dāšdH®I†dޚdH^Ÿ‹ Éės‘!™Ó’1m‘!y·.2äŽN,‹ ٳu"{¶.RdĻÖEŒģŁŗČ‘<[ėAäŁZ’$ĻÖz%y¶ÖćĪ”!Ճ0ɲ¤Iõ Mņ€¬Ē')SŖĒ))WŖĒ+)[Ŗ‰4ɲ¦;_RĘTӝ1)gŖéĪ™n­é?’é§÷ßżńóė’럾žž?’Ū’ņŲÉ8!graph/inst/GXL/graphExample-13.gxl.gz0000644000175200017520000000036714516003535020305 0ustar00biocbuildbiocbuild‹ą`įCgraphExample-13.gxlR½Ā Ž} Ā.Ųµiu2.³[C) ”­Ō>½G[7‡HŽ|wÉWœ¦—%ozćŗ’fģ@OĒ)ōdsxŠ®OSIŪaš9ē1F¦G“Š_npŸ±ŒÉARnŚ |KŒ,é2]Ļ%JjõrR•tģ¤ ź>ØU±J:€…SŻn’!xQ¼ĘĶ(ތō{8Wß½G2fCŽ‰‰q“¦šÄ˜ĖFę'&&hGs„‹ <±1=µ š÷wƒõ·3uoe?ī¾½Šu:graph/inst/GXL/graphExample-14.gxl.gz0000644000175200017520000000064414516003535020304 0ustar00biocbuildbiocbuild‹ą`įCgraphExample-14.gxl•ÖOo‚0š»Ÿ‚ō>°­ā4¢§e³ó®ĖčŌ +ˆ~ūńG8:ó]˜NtÄÖK­ų}¼ ś·O2'"“™”ČX"“™œČœ‰Œ#2"S™’Č\‰LEdnDꞦÆ6#…÷㲓ÆČ`žšŌ£z“šFƒ9f֛“3 aę`˜³…`˜³-zcł}^Į0ū,Į0=S@)ƒ†I8ó§“ µ“d4 ƒć.瀨šB@TĖ€ØF¼¢1LD9ā;Ä4BI@L#”Ä4Bi@L#Ō cŠ0×5…€Øš€Øš†‰ØFo ˆ9ž&ā>āO\bĘH+@LMZ¢jšbZ®ē€˜1Ņ! ņź¾µwŗęš<ɍ=CI graph/inst/GXL/graphExample-15.gxl.gz0000644000175200017520000000214614516003535020304 0ustar00biocbuildbiocbuild‹ą`įCgraphExample-15.gxl•šKoA„ļłˆ{`fwvVœœ¢\¢œsM¼kĄęe`_üś`c¦„RU,ØOŽķ®īYJžōeŲ¬']s8®vŪū©™é—Ļ&ŸĆśīņ3¹|ŗ=¾žv?]žNū»ł¼ļūŁ¢Żv³ŗ™ūł}~łš£ŁY}Ŗ§ō=üŚ/'«ś~śöŪÆß§“¦^4›]ŻÜOŪm½:4§ęJ\‘ķå£7ā×ū›óŪ»Ńü&4„¦&4 ”y$4 B³$4+BóDhž ͚ŠlĶ–ŠģĶžŠ¼š”9š”i MGhzB3š‘Šœ’­yć7N»Ķė MN;˜ŪWÕ_˜āĘŌU@LŸŖ ¦O•ˆéSU“a Š–²#öŠ’G€Øå³Ā¼ˆYaŽÄ4×1Ķõ%@Ģhx3¾ˆŁ{>;āEqO ʰ>Ä,ŸbŖ @Lõ‚ˆ©^(b†0”ķČ“g ģˆ?¹ĮÄ,Ėbę)D€ļ…ć½hb¼-@̲Œ@/ ”qT|sw1Ė2V1}Š Ŗz fcˆ˜bś” @Ģ& 3„©čĄ@Ł'~r“ˆ s*€˜ć3y€„3¹)Äx/%€˜Só̭±@1Šq’5č ĘJÖ -Ž•}Ń*²7ćā²Į•T™U™c(+ńeĖ/&+łe«p”˜­ĀQ’`¶ GI„ŁņĒ•µč ŹQbvüz²’bvŠ8WbĢNįCÉ1;ÅŽ ³ć+If§Ø¼D™bH–Ł)ś%aę;u¢Ø ؖ¢²7zE—%Ļģ@Ķ^±$Ńģ@"Ķ^į É4{…7$Ōģ]–TsPģy‰5Å,K®9(¦R‚ĶAq:H²9(ŗ,Ńę Ų’mü³®•psP8JŅĶA±$޳ģŠŌ,;ōFGQŁ#’ČJÄ9*|(ēØš”„œ£Ā‡’rŽü—\+1ēØš”䜣ĀQtŽŠē I:GÅf“ØsTø·BoP›­Bo •½qVœDwžŪFņγ¢_xžOz’xžgŠDžgÅŽĢóüŸ p}õöo\——ļƆõēCvĄµ<&graph/inst/GXL/graphExample-16.gxl.gz0000644000175200017520000000443714516003535020312 0ustar00biocbuildbiocbuild‹ā`įCgraphExample-16.gxl•œMSÜF†ļžŌŽŅĢH#¹Œ}JåāŹ9WĢ.»‹łņ²ŸłõŪ­&ŻNźéƒ« ĢS£§ßY^Vśšéxw¶_lž×—³ö¼™}śųīģĆņx÷žåߣĖWž_’w9[m·Oļ/.‡Ćłr÷“y<Ÿ/.žųėóÅĖkĻŪółv>{A²›«§ÕŁz~9ūžæ?’<;[Ģ—‹ūĒłār¶{˜Æ7‹ėķāńyxłŅwāźē'/䳿Xó¬¹kę`ͬ¹k–`Ķ ¬Yƒ5·`ĶW°ę¬¹kĄšG°ę ¬łÖlĄšg°f ÖģĄš=XskŽ`Ķ ¬ł¬¹BƒŠ&*šU4¬hZŃø¢yEū?ūœßµ³³›ĶćżkümMR¾®ś“„Yp& sƙb˜`:Ć\¦fÉæ·jņ½ †¹Ģhņ󓍁¾h2aÅw”M"ŪŠf‘}h‹–ź „vÆ7ڽɇu`÷”Ż Dv/5"»—Z­” D¶ˆ¤QŸ D,Ȗ÷Č–÷½ˆå}5ŗNƒŠu DF£6"iT­÷²FyŖÖˆMF| üLˆ{µ7qÆV÷ź` ā^ D4†Ö@Ĉ!č‰@Ł@$kqo°FÉ¬DŲa2bų™” c4ź0ĖĒÖ@Äņ1ˆX>f‘ė4‘Ń;‘Ń{ĖĒɈgnÄ8ˆX>ŽBÅLÓŠ\ݶi E®TŪ$C‘KÕ6ŁPdŪ¦Š\¬¶é õ Q“Ū@ēŌTC”Ņ© …:»f4rCėĖmĄ ķ/·|ō[-0·£“ĮÜŒŅ s˧æÕs0ŖµnleŻ`űuMJkŻ@Ī'ėĘ3¢&7v‘n; ķ†v™»€óZfīĪk›¹ Ų«uę.`Æö™»ĄUÖBs°WĶ]Ą ­4w7²uc‹ØÉ}ą/ Śjī)Ŗµę>`”öšū€QZlī)ŖĶę>`”V›ū@j·¹ēæ)“Znīj»¹xX¬(mŠu„M±n (Ö 4ĖÅŗę«X7Š|ėĘQ“‡ĄĪkĶy¼"Ņžó˜e-:YÖ¦ó˜e­:YÖ®ó0JĖĪC “ķ<@ėĪC`–;ėzEŌ[7½½uƒżŻŁŗ’­·n Œź­{DMn#?Wo(4)Ś{“¢Åē10)Ś|“¢Õē1ą¼vŸĒ€óZ~nhūy LŠÖŸĒ€QÕŗŒŖÖ¢¬(ē«uƒ½±Ćŗņp°n v°n v°n Œ¬č„Õ"ōŲymBO×*ōHķBOŠ2ō¹Ź£”Phz ø”}č)0ĖZˆž³¬č)ąįhŻ@ŽÖ äįhŻ@i3Z7ŽˆšÜøŗ HÆÅØ`Äś¤ĶØ`čŻFZ †Žo¤ŻØ`Dü¤åØ`Äü¤ķØ`Dż¤õØ`Äż¤żØ`Dž¤©`ÄžŌ8Kˆž©q–’Sė,!Zg ™€Ō:KN›,¹¾ęƒ““' Ž„‚±79öCƒ£U©`hp“+ Ž–„‚”ĮѶT048Z— †GūRĮŠą$g œä,Aƒ“œ%hp’³ Nr– ĮIĪ’+49Ś›Ī灁ÓāT0ōVZmNCo¦ÕźT04§Ś †ęTĖSĮŠ[jµ= ·Ö§‚”ńÖžT0ņKaŅU04ŽŁYBŖTœ%hN‹³„üЗгÅY‚‚²8KPāg J¼ā,AŃUœ%(ŗŠ³EWq– čźœ%,ŗ:§É5ŗs@ ÕłwRIUĮPvi„*Ź.ķTCŁ„„Ŗ`(»“U …ÖŖ‚”Ņ^U0RM%-VCلͪ`hP{g ŽY‚²«w– ‰Óvõ&p“\ŅzU0””ŚÆ †TւU0¤²6¬‚”óT+VĮŹŚ± †N-YCNjĖ*rRkVĮŠįQ%č®ĪtęTg œź,AP%čĢœ%ģĢœ&ģĢœ'’¾‘ų?¹I”eąnԝė2pćhŅŅU04ąŚŗ Ęn\«Cg•ö®‚”×āU0tVió*:«“z å‚vƂ”\%häFg :«Fg šŌŃY²@æ3ŽN4©£Óq£Óݧ×8MČń‘§ ōÜ8MH ēĘiB=7N±¹qš ˆĶóElnœ'(bsćD¹A·›j » Ü*žµ†]īeĻoīµÜĶžßÜmæāќßÜoæāќßÜqæāќßÜsæāќßÜuæāќµ†ŒDsÖV0͹u–hĪÉYB¢9'g ‰ęœœ%(šsrš,‘•Éy‚’!9OŠĶÉy‚"=9OP¤'ē Šōäģ>߾ݒæ<}üQ>Żģææ¼<}ŗ¾~}}½ŗżłō|ŗ:Æ’óŪµ<üØÆōÕįå°čūü×Ó÷ŻŻįf?}ść·oūŻńp{|8Ž7ūŸ‡»ēćß/Ē1Cåф°Ńśó’ƗļšKĢB ĄĢėœŲhŽŒę-j2š˜`–“E£)oČä¼×ä¼2˜9¶T1#‡Ŗ³Ī™ "Ł99-²#.”Ńt°Šl‰1¢Nm]ŠŌ+[EtŠĶŽøM6ó*§^ĮŃŹ}å#Y‚IÄiRŽŒf•Aé*ÄÄĢP,yoŃžjƒrßt Z‘ˆ“q踌&fŚ›@²ŗŲ‘·¬,)”6’†(©Qh:£ČÜ 9,AF#!ēU ß$“TŃiy“qž-Õ)E–š b/9{V€Ł”*CŅ!)Ä#²RT1mB9:T!29N£”;ĘĮŽ#æQ”&R£rć2ā`#+7‘kL¤L‹SÖkdšNv¬UÖb‡G”žĖETäÄ õU™Ż dĶĪxÄRoŠåĄX”¬’ö*£JķQ„ö*±ŽE£ž?”¾UĢŠ¾ĖB3”ü;”ÕÅ%¢č¾ä3źŌœō‡0†Ń…I£&G؟œ˜ä—E^Yp Y'ĘN%¬Ķ؆ÉbQ™X3»/3J”Ė+&ØlŹh첁F“ŽŽõߨ–ˆŗ{ĒĤXĄ,JCPw%fØAԈš„ÓŁž"ö Õ1#Nuȵ„‘ŽŃYÖ(³¢%‚ń’ńč¼ō’õEl‡Ūļžy>=œ5ÉŻĖéRÄ,¶ļ Ķ‚œĆØ]qBn%ŃŅ­N‹ź5āÓ/ČIA†9k^3t#ŗu qNśÖˆÓ“nQQŸ&äVĮė óź³R#›+į¼i‘Fę«k Ejj*TšÕ”ŪK(Ü&ķšÅŗ0ęv ¦IõZģM“4C·’{»†Ó$-n¦žK<]HŒ=ln Å”0kHMĀĢŻŹL=h(æLy+÷ 5¢Ģ²ÉŪ78=Ømöø²Z$PW'¬ĘhĶTv*ŹÉŠ7ōTd {”–õĄ±‚ĒRĄŌ€*zÅ9ó“2T'fƛ·I½ĀQŖó>m„TWh#(kjņd?“Vk/”[ɾumŚ„±ƒµk@ĶĀĆŠœĆ{ŲĢŃĆ®5 뤑ćŌp£YN÷׋NŚT=[yĘØkbŖŌ“ŁėÆÆT{ŠJQåR9{ݼßéA+Ed$ \-zE™”›wT=hCQ:/Īh­kDMšĒE¹–¢ÖÜƒŲ†”bĢWIJĒĮØØEoŅFČ«:ē"Œ¬×WšŹK‡{”k÷°µ%/÷ž”īŲÖå-`ö»Õµ{ą¶+7C•Śū:e?ŲŠ‡Ę«óŗÕ$.œYŁ ³­y†¼ę¦xå”āŚŗgĘ ŗc‘†n>5 ĀŅ–ĄÅ†¦JcūÖpš¤‰!Øoy­ŌˆCø„n•ē46daUšÜŠÜóģXkš¶¼Č#—ŸXŪņø\`¶æ­éA›>jér·/zPÓԁ%ž.¤ģø2Ō¤€ 9®eO/MÉöW tž6ż,M¾žæ½Żłše~œ 'graph/inst/GXL/graphExample-18.gxl.gz0000644000175200017520000000030714516003535020304 0ustar00biocbuildbiocbuild‹ā`įCgraphExample-18.gxl‘»ƒ0 E÷~Eä½IY©ź‚:w„Ų ‘   ŸßščĘąĮ’ķ{ĪbgÅҵāK~“½ÓČłEdfiÓX"¦n\; MCŖŌ<ĻŅLƒļ%’z¼JĆk"‰!Ŗ‡ė«”5lŻó^‚ 4ŌõH&‡ÖSh7vÅÅh3Ŗc©žŪęĶ`jƒ †̇ĮÓ0{ĘģÓvģõźx`~łĖXԚāgraph/inst/GXL/gxl-1.0.1.dtd0000644000175200017520000000664714516003535016245 0ustar00biocbuildbiocbuild graph/inst/GXL/kmstEx.gxl0000644000175200017520000000162014516003535016274 0ustar00biocbuildbiocbuild 1 1 2 7 3 1 1 1 graph/inst/GXL/outOfOrderExample.gxl0000644000175200017520000000144514516003535020432 0ustar00biocbuildbiocbuild 127 27 test.c main.c 225 316 42 graph/inst/GXL/simplExample.gxl.www0000644000175200017520000000312014516003535020301 0ustar00biocbuildbiocbuild main.c test.c 225 316 127 27 42 graph/inst/GXL/simpleExample.gxl0000644000175200017520000000130114516003535017622 0ustar00biocbuildbiocbuild main.c test.c 225 316 127 27 42 graph/inst/Scripts/0000755000175200017520000000000014516003535015303 5ustar00biocbuildbiocbuildgraph/inst/Scripts/Graph.R0000644000175200017520000000577714516003535016507 0ustar00biocbuildbiocbuild##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/Scripts/distGraph.R0000644000175200017520000000126314516003535017355 0ustar00biocbuildbiocbuild ##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/multigraph.R0000644000175200017520000000100414516003535017575 0ustar00biocbuildbiocbuild 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/pTreetest.R0000644000175200017520000000046014516003535017405 0ustar00biocbuildbiocbuild 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.R0000644000175200017520000000303214516003535021032 0ustar00biocbuildbiocbuild## ------------------------------------------------------------ ## (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/doc/0000755000175200017520000000000014516033236014422 5ustar00biocbuildbiocbuildgraph/inst/doc/GraphClass.R0000644000175200017520000000046014516033217016573 0ustar00biocbuildbiocbuild## ----message=FALSE------------------------------------------------------------ library("graph") ## ----------------------------------------------------------------------------- getClass("graph") ## ----------------------------------------------------------------------------- getClass("multiGraph") graph/inst/doc/GraphClass.Rmd0000644000175200017520000002521714516003535017123 0ustar00biocbuildbiocbuild--- title: "Graph Design" author: - name: "R. Gentleman" - name: "Elizabeth Whalen" - name: "W. Huber" - name: "S. Falcon" - name: "Halimat C. Atanda" affiliation: "Vignette translation from Sweave to Rmarkdown / HTML" date: "`r format(Sys.Date(), '%B %d %Y')`" package: graph output: BiocStyle::html_document vignette: > %\VignetteIndexEntry{Graph Design} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- # Introduction The purpose of this document is to describe the implementation of the classes used to represent graphs in the *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 *graph* package and define the set of methods that form the *graph interface* as determined empirically by the methods used by packages like `r Biocpkg("RBGL")` when interacting with *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 *simple graph* is a graph with at most one edge between any pair of nodes and no self-loops. # The *graph* class The *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, a node, or 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. *This raises the question of whether we should use the AnnotatedDataFrame class from* `r Biocpkg("Biobase")` *here as a way to implement general node and edge attributes.* *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 *graph* class itself is VIRTUAL and has the following definition: ```{r message=FALSE} library("graph") ``` ```{r} getClass("graph") ``` The `edgemode` slot indicates whether the graph is *directed* or *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 `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 `isDirected` do the right thing. The `edgeData` and `nodeData` slots store the attributes for the edges and nodes of the graph, respectively. There are currently implementations for the *graphNEL* class, where nodes are a vector and edges are a list, each element of the list corresponds 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 *graphAM* class stores the edge information in an adjacent 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. The first is *distGraph*, which takes a distance matrix directly and has special thresholding capabilities. It is not clear whether this should be a specialization of the *graphAM* class or not. The second specialized class is a *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 `undirected`. If the edgemode is reset, then coercion to some other mode of graph is needed. ## Methods of graphs Here are some of the methods that all graph-like objects should support: `nodes(object)` Returns a character vector of the node labels. The order is not defined. `nodes<-(object)` Returns a new graph object with the node labels set as specified by a character vector. This is slightly fragile since the order matters. But the order can only really be determined by first calling the _R_ function, `nodes`, and then providing a character vector of the appropriate length. `addNode(node, object, edges)` Returns a new graph object with additional nodes and (optionally) edges. The methods that have been implemented expect `node` to be the node labels of the new nodes specified as a character vector. Optional edges can be specified. `removeNode(node, object)` Returns a new graph object with nodes (and their incident edges) removed. Current methods are implemented for `node` being a character vector of node labels to remove. `edges(object, which)` Returns 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. `edgeWeights(object, index)` `addEdge(from, to, graph, weights)` Returns a new graph object with additional edges. `removeEdge(from, to, graph)` Returns a new graph object with the specified edges removed. `numNodes(object)` Returns a count of the nodes in the graph. `numEdges(object)` Returns a count of the edges in the graph. `isDirected(object)` Returns TRUE if the graph is directed, and FALSE otherwise. `acc(object, index)` See man page. `adj(object, index)` See man page. `nodeData` Access to node attributes. See man page. `edgeData` Access to edge attributes. See man page. ## 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 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. ### Representation of Edges 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 *graphNEL* class, we do not store the names of the nodes in the NEL, but rather index 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 it means that knowledge of the edges does not provide knowledge of the nodes. # Multi-graphs There are no clear and widely used definitions for multi-graphs. So here, we will make a clear definition that we believe will be useful for biological computations. We define a multi-graph as a graph that consists 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 *directed* or *undirected* and self-loops are allowed. It is not clear whether there should be distinct types of multi-graphs 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 *graph* class. The definition is: ```{r} getClass("multiGraph") ``` `nodes` A vector of node identifiers. `edgeL` A possibly named list of instances of the *edgeSet* class. The *edgeSet* class is a virtual class with several different extensions. These include a *edgeSetNEL* and an *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. ## Methods In some ways, it would be most natural to have `edges` methods for the *edgeSet* class. The issues raised in Section 2.2.1 seem to preclude this and it only seems to make sense to have `node` and `edges` methods for the *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. ## Use Cases An important motivator for the *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. # 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$. graph/inst/doc/GraphClass.html0000644000175200017520000235347114516033220017347 0ustar00biocbuildbiocbuild Graph Design

Contents

1 Introduction

The purpose of this document is to describe the implementation of the classes used to represent graphs in the 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 graph package and define the set of methods that form the graph interface as determined empirically by the methods used by packages like RBGL when interacting with 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 simple graph is a graph with at most one edge between any pair of nodes and no self-loops.

2 The graph class

The 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, a node, or 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.

This raises the question of whether we should use the AnnotatedDataFrame class from Biobase here as a way to implement general node and edge attributes.

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 graph class itself is VIRTUAL and has the following definition:

library("graph")
getClass("graph")
## Virtual Class "graph" [package "graph"]
## 
## Slots:
##                                                   
## Name:    edgeData   nodeData renderInfo  graphData
## Class:   attrData   attrData renderInfo       list
## 
## Extends: "graphBase"
## 
## Known Subclasses: "graphNEL", "graphAM", "distGraph", "clusterGraph", "graphBAM"

The edgemode slot indicates whether the graph is directed or 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 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 isDirected do the right thing.

The edgeData and nodeData slots store the attributes for the edges and nodes of the graph, respectively.

There are currently implementations for the graphNEL class, where nodes are a vector and edges are a list, each element of the list corresponds 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 graphAM class stores the edge information in an adjacent 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. The first is distGraph, which takes a distance matrix directly and has special thresholding capabilities. It is not clear whether this should be a specialization of the graphAM class or not.

The second specialized class is a 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 undirected. If the edgemode is reset, then coercion to some other mode of graph is needed.

2.1 Methods of graphs

Here are some of the methods that all graph-like objects should support:

nodes(object) Returns a character vector of the node labels. The order is not defined.

nodes<-(object) Returns a new graph object with the node labels set as specified by a character vector. This is slightly fragile since the order matters. But the order can only really be determined by first calling the R function, nodes, and then providing a character vector of the appropriate length.

addNode(node, object, edges) Returns a new graph object with additional nodes and (optionally) edges. The methods that have been implemented expect node to be the node labels of the new nodes specified as a character vector. Optional edges can be specified.

removeNode(node, object) Returns a new graph object with nodes (and their incident edges) removed. Current methods are implemented for node being a character vector of node labels to remove.

edges(object, which) Returns 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.

edgeWeights(object, index)

addEdge(from, to, graph, weights) Returns a new graph object with additional edges.

removeEdge(from, to, graph) Returns a new graph object with the specified edges removed.

numNodes(object) Returns a count of the nodes in the graph.

numEdges(object) Returns a count of the edges in the graph.

isDirected(object) Returns TRUE if the graph is directed, and FALSE otherwise.

acc(object, index) See man page.

adj(object, index) See man page.

nodeData Access to node attributes. See man page.

edgeData Access to edge attributes. See man page.

2.2 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 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.

2.2.1 Representation of Edges

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 graphNEL class, we do not store the names of the nodes in the NEL, but rather index 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 it means that knowledge of the edges does not provide knowledge of the nodes.

3 Multi-graphs

There are no clear and widely used definitions for multi-graphs. So here, we will make a clear definition that we believe will be useful for biological computations. We define a multi-graph as a graph that consists 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 directed or undirected and self-loops are allowed.

It is not clear whether there should be distinct types of multi-graphs 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 graph class. The definition is:

getClass("multiGraph")
## Class "multiGraph" [package "graph"]
## 
## Slots:
##                                               
## Name:      nodes     edgeL  nodeData graphData
## Class:    vector      list  attrData      list

nodes A vector of node identifiers.

edgeL A possibly named list of instances of the edgeSet class.

The edgeSet class is a virtual class with several different extensions. These include a edgeSetNEL and an 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.

3.1 Methods

In some ways, it would be most natural to have edges methods for the edgeSet class. The issues raised in Section 2.2.1 seem to preclude this and it only seems to make sense to have node and edges methods for the 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.

3.2 Use Cases

An important motivator for the 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.

4 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\).

graph/inst/doc/MultiGraphClass.R0000644000175200017520000001446114516033232017611 0ustar00biocbuildbiocbuild## ----message=FALSE------------------------------------------------------------ library(graph) ## ----------------------------------------------------------------------------- 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 ## ----------------------------------------------------------------------------- nodes(g) edgeWeights(g, index = c("SEA", "LAX")) ## ----------------------------------------------------------------------------- g <- addNode("IAH", g) g <- addEdge(from = "DEN", to = "IAH", graph = g, weight = 120) g ## ----------------------------------------------------------------------------- g <- removeEdge(from ="DEN", to = "IAH", g) g <- removeNode(node = "IAH", g) g ## ----------------------------------------------------------------------------- g <- subGraph(snodes = c("DEN","LAX", "SEA"), g) g ## ----------------------------------------------------------------------------- extractFromTo(g) ## ----------------------------------------------------------------------------- data("esetsFemale") data("esetsMale") ## ----------------------------------------------------------------------------- dfMale <- esetsMale[["brain"]] dfFemale <- esetsFemale[["brain"]] head(dfMale) ## ----------------------------------------------------------------------------- male <- graphBAM(dfMale, edgemode = "directed") female <- graphBAM(dfFemale, edgemode = "directed") ## ----------------------------------------------------------------------------- intrsct <- graphIntersect(male, female, edgeFun=list(weight = sum)) intrsct ## ----------------------------------------------------------------------------- resWt <- removeEdgesByWeight(intrsct, lessThan = 1.5) ## ----------------------------------------------------------------------------- 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" ## ----message=FALSE------------------------------------------------------------ library(graph) library(RBGL) ## ----------------------------------------------------------------------------- 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) ## ----------------------------------------------------------------------------- esets <- list(Alaska = ft1, United = ft2, Delta = ft3, American = ft4) mg <- MultiGraph(esets, directed = TRUE) mg ## ----------------------------------------------------------------------------- nodes(mg) ## ----------------------------------------------------------------------------- mgEdgeData(mg, "Delta", from = "SEA", attr = "weight") ## ----------------------------------------------------------------------------- nodeDataDefaults(mg, attr="shape") <- "square" nodeData(mg, n = c("SEA", "DEN", "IAH", "LAX", "SFO"), attr = "shape") <- c("triangle", "circle", "circle", "circle", "circle") ## ----------------------------------------------------------------------------- nodeData(mg, attr = "shape") ## ----------------------------------------------------------------------------- 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") ## ----------------------------------------------------------------------------- g <- subsetEdgeSets(mg, edgeSets = c("Alaska", "United", "Delta")) ## ----------------------------------------------------------------------------- edgeFun <- list( weight = min) gInt <- edgeSetIntersect0(g, edgeFun = edgeFun) gInt ## ----------------------------------------------------------------------------- mgEdgeData(gInt, "Alaska_United_Delta", attr= "weight") ## ----------------------------------------------------------------------------- data("esetsFemale") data("esetsMale") names(esetsFemale) head(esetsFemale$brain) ## ----------------------------------------------------------------------------- female <- MultiGraph(edgeSets = esetsFemale, directed = TRUE) male <- MultiGraph(edgeSets = esetsMale, directed = TRUE ) male female ## ----------------------------------------------------------------------------- maleBrain <- extractGraphBAM(male, "brain")[["brain"]] maleBrain femaleBrain <- extractGraphBAM(female, "brain")[["brain"]] ## ----------------------------------------------------------------------------- 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 ## ----------------------------------------------------------------------------- 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") ## ----------------------------------------------------------------------------- resInt <- graphIntersect(male, female) resInt graph/inst/doc/MultiGraphClass.Rmd0000644000175200017520000004133014516003535020130 0ustar00biocbuildbiocbuild--- title: "graphBAM and MultiGraph classes" author: - name: "N. Gopalakrishnan" - name: "Halimat C. Atanda" affiliation: "Vignette translation from Sweave to Rmarkdown / HTML" date: "`r format(Sys.Date(), '%B %d %Y')`" package: graph output: BiocStyle::html_document vignette: > %\VignetteIndexEntry{graphBAM and MultiGraph Classes} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- # graphBAM class ## Introduction The *graphBAM* class has been created as a more efficient replacement for the *graphAM* class in the *graph* package. The adjacency matrix in the *graphBAM* class is represented as a bit array using a `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 *graph* package which provides the class definition and methods for the *graphBAM* class. ```{r message=FALSE} library(graph) ``` One of the arguments `df` to the *graphBAM* constructor is a `data.frame` containing three columns: "from","to" and "weight", each row in the `data.frame` representing an edge in the graph. The `from` and `to` columns can be character vectors or factors, while the `weight` column must be a numeric vector. The argument `nodes` are calculated from the unique names in the `from` and `to` columns of the `data.frame`. The argument `edgeMode` should be a character vector, either "directed" or "undirected" indicating whether the graph represented should be directed or undirected respectively. ## A simple graph represented using graphBAM class We proceed to represent a simple graph using the *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 (`from`) to the destination city (`to`). The weight represents the fare for flying between the `from` and `to` cities. ```{r} 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 *graph* object as well as the stored fares(`weight`) can be obtained using the `nodes` and `edgeWeights` methods respectively. ```{r} nodes(g) edgeWeights(g, index = c("SEA", "LAX")) ``` Additional nodes or edges can be added to our graph using the `addNode` and `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. ```{r} 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 `removeNode` and `removeEdge` methods respectively. We proceed to remove the flight connection from "DEN" to "IAH" and subsequently the node "IAH". ```{r} 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 `subGraph` method. ```{r} g <- subGraph(snodes = c("DEN","LAX", "SEA"), g) g ``` We can extract the `from`-`to` relationships for our graph using the `extractFromTo` method. ```{r} extractFromTo(g) ``` ## 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 *graph* package as a list of `data.frame`s containing information for `from-gene`, `to-gene` and the strength of interaction `weight` for each of the tissues studied. We proceed to load the data for male and female mice. ```{r} 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 *graphBAM* objects for male and female mice. ```{r} dfMale <- esetsMale[["brain"]] dfFemale <- esetsFemale[["brain"]] head(dfMale) ``` ```{r} 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 `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 `sum` as the function for handling weights to the `edgeFun` argument. The `edgeFun` argument should be passed a list of named functions corresponding to the edge attributes to be handled during the intersection process. ```{r} intrsct <- graphIntersect(male, female, edgeFun=list(weight = sum)) intrsct ``` If node attributes were present in the `graphBAM` objects, a list of named function could be passed as input to the `graphIntersect` method for handling them during the intersection process. We proceed to remove edges from the `graphBAM` result we just calculated with a weight attribute less than a numeric value of 0.8 using the `removeEdgesByWeight` method. ```{r} 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 `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 `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 `resWt` graph using the `extractFromTo` method and then make use of the `edgeData` method to update the "color" edge attribute. ```{r} 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" ``` # MultiGraphs ## Introduction The *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 `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 *MultiGraph* class representation (i.e. the from-node is the same as the to-node). The *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 `r Biocpkg("graph")` and `r Biocpkg("RBGL")` packages that we will be using. We will then create a *MultiGraph* object and then spend some time examining some of the different functions that can be applied to *MultiGraph* objects. ```{r message=FALSE} library(graph) library(RBGL) ``` ## A simple MultiGraph example We proceed to construct a *MultiGraph* object with directed `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 *MultiGraph* and we have one `edgeSet` each for the airlines. Each `edgeSet` represents the flight connections from an originating city(`from`) to the destination city(`to`). The weight represents the fare for flying between the `from` and `to` cities. For each airline, we proceed to create a *data.frame* containing the originating city, the destination city and the fare. ```{r} 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 *MultiGraph* class constructor as a named `list`, each member of the list being a `data.frame` for an airline. A logical vector passed to the `directed` argument of the *MultiGraph* constructor indicates whether the `MultiGraph` to be created should have directed or undirected edge sets. ```{r} esets <- list(Alaska = ft1, United = ft2, Delta = ft3, American = ft4) mg <- MultiGraph(esets, directed = TRUE) mg ``` The nodes (cities) of the *MultiGraph* object can be obtained by using the `nodes` method. ```{r} nodes(mg) ``` To find the fares for all the flights that originate from SEA for the Delta airline, we can use the `mgEdgeData` method. ```{r} mgEdgeData(mg, "Delta", from = "SEA", attr = "weight") ``` We proceed to add some node attributes to the `MultiGraph` using the `nodeData` method. Before node attributes can be added, we have to set a default value for each node attribute using the `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 `"triangle"` and that for the cities that connect with Seattle to the value `"circle"`. ```{r} 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". ```{r} nodeData(mg, attr = "shape") ``` We then update the edge attribute `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 `mgEdgeDataDefaults` method. Subsequently, the `megEdgeData<-` method can be used to update specific edge attributes. ```{r} 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 *MultiGraph* object containing edge sets for only these airlines. This can be achieved using the `subsetEdgeSets` method. ```{r} 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 `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 `weight` function that calculates the minimum of the fares as the input to the `edgeSetIntersect0` method. (The user has the option of specifying any function for appropriate handling of edge attributes ). ```{r} edgeFun <- list( weight = min) gInt <- edgeSetIntersect0(g, edgeFun = edgeFun) gInt ``` The edge set by the `edgeSetIntersect0` operation is named by concatenating the names of the edgeSets passed as input to the function. ```{r} mgEdgeData(gInt, "Alaska_United_Delta", attr= "weight") ``` ## 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 *graph* package as a list of `data.frame`s containing information for `from-gene`, `to-gene` and the strength of interaction `weight` for each of the tissues studied. We proceed to load the data for male and female mice. ```{r} data("esetsFemale") data("esetsMale") names(esetsFemale) head(esetsFemale$brain) ``` The `esetsFemale` and `esetsMale` objects are a named `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 *MultiGraph* objects for the male and female data sets by making use of the *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. ```{r} 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 `r Biocpkg("RBGL")` package that we will use to find the edges that are connected to the gene "10024416717" do not work directly with *MultiGraph* objects, we proceed to create `graphBAM` objects from the male and female edge sets for the brain tissue. *MultiGraph* objects can be converted to a named list of `graphBAM` objects using the `graphBAM` method. ```{r} 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 `bellman.ford.sp` function from the `r Biocpkg("RBGL")` package. ```{r} 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 `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 attribute of "gray". ```{r} 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 `MultiGraph` objects now contain the required node attributes for the subset of genes that we have narrowed our selection to. For the `MultiGraph` objects for male and female, we are also interested in the genes that are common to both `MultiGraph`s. This can be calculated using the `graphIntersect` method. ```{r} resInt <- graphIntersect(male, female) resInt ``` The operations we have dealt with so far only deal with manipulation of *MultiGraph* objects. Additional functions will need to be implemented for the visualization of the *MultiGraph* objects.graph/inst/doc/MultiGraphClass.html0000644000175200017520000240357014516033233020362 0ustar00biocbuildbiocbuild graphBAM and MultiGraph classes

Contents

1 graphBAM class

1.1 Introduction

The graphBAM class has been created as a more efficient replacement for the graphAM class in the graph package. The adjacency matrix in the graphBAM class is represented as a bit array using a 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 graph package which provides the class definition and methods for the graphBAM class.

 library(graph)

One of the arguments df to the graphBAM constructor is a data.frame containing three columns: ā€œfromā€,ā€œtoā€ and ā€œweightā€, each row in the data.frame representing an edge in the graph. The from and to columns can be character vectors or factors, while the weight column must be a numeric vector. The argument nodes are calculated from the unique names in the from and to columns of the data.frame. The argument edgeMode should be a character vector, either ā€œdirectedā€ or ā€œundirectedā€ indicating whether the graph represented should be directed or undirected respectively.

1.2 A simple graph represented using graphBAM class

We proceed to represent a simple graph using the 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 (from) to the destination city (to). The weight represents the fare for flying between the from and 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
## A graphBAM graph with directed edges
## Number of Nodes = 4 
## Number of Edges = 5

The cities (nodes) included in our graph object as well as the stored fares(weight) can be obtained using the nodes and edgeWeights methods respectively.

nodes(g) 
## [1] "DEN" "LAX" "SEA" "SFO"
edgeWeights(g, index = c("SEA", "LAX"))
## $SEA
## DEN LAX SFO 
## 259 124  90 
## 
## $LAX
## SEA 
## 115

Additional nodes or edges can be added to our graph using the addNode and 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
## A graphBAM graph with directed edges
## Number of Nodes = 5 
## Number of Edges = 6

Similarly, edges and nodes can be removed from the graph using the removeNode and 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
## A graphBAM graph with directed edges
## Number of Nodes = 4 
## Number of Edges = 5

We can create a subgraph with only the cities ā€œDENā€, ā€œLAXā€ and ā€œSEAā€ using the subGraph method.

g <- subGraph(snodes = c("DEN","LAX", "SEA"), g) 
g
## A graphBAM graph with directed edges
## Number of Nodes = 3 
## Number of Edges = 3

We can extract the from-to relationships for our graph using the extractFromTo method.

extractFromTo(g)
##   from  to weight
## 1  SEA DEN    259
## 2  SEA LAX    124
## 3  LAX SEA    115

1.3 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 graph package as a list of data.frames containing information for from-gene, to-gene and the strength of interaction 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 graphBAM objects for male and female mice.

dfMale <- esetsMale[["brain"]]
dfFemale <- esetsFemale[["brain"]]
head(dfMale)
##          from          to weight
## 1 10024402938 10024393150  0.835
## 2 10024415240 10024393156  0.667
## 3 10024403128 10024393162  0.312
## 4 10024409968 10024393162  0.482
## 5 10024393260 10024393163  0.997
## 6 10024394731 10024393165  0.714
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 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 sum as the function for handling weights to the edgeFun argument. The 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
## A graphBAM graph with directed edges
## Number of Nodes = 2117 
## Number of Edges = 473

If node attributes were present in the graphBAM objects, a list of named function could be passed as input to the graphIntersect method for handling them during the intersection process.

We proceed to remove edges from the graphBAM result we just calculated with a weight attribute less than a numeric value of 0.8 using the 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 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 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 resWt graph using the extractFromTo method and then make use of the 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"

2 MultiGraphs

2.1 Introduction

The 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 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 MultiGraph class representation (i.e.Ā the from-node is the same as the to-node). The 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 graph and RBGL packages that we will be using. We will then create a MultiGraph object and then spend some time examining some of the different functions that can be applied to MultiGraph objects.

library(graph) 
library(RBGL)

2.2 A simple MultiGraph example

We proceed to construct a MultiGraph object with directed 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 MultiGraph and we have one edgeSet each for the airlines. Each edgeSet represents the flight connections from an originating city(from) to the destination city(to). The weight represents the fare for flying between the from and to cities.

For each airline, we proceed to create a 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 MultiGraph class constructor as a named list, each member of the list being a data.frame for an airline. A logical vector passed to the directed argument of the MultiGraph constructor indicates whether the 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
## MultiGraph with 6 nodes and 4 edge sets
##  edge_set directed edge_count
##    Alaska     TRUE          5
##    United     TRUE          9
##     Delta     TRUE         10
##  American     TRUE          7

The nodes (cities) of the MultiGraph object can be obtained by using the nodes method.

nodes(mg)
## [1] "BWI" "DEN" "IAH" "LAX" "SEA" "SFO"

To find the fares for all the flights that originate from SEA for the Delta airline, we can use the mgEdgeData method.

mgEdgeData(mg, "Delta", from = "SEA", attr = "weight")
## $`SEA|DEN`
## [1] 281
## 
## $`SEA|IAH`
## [1] 282
## 
## $`SEA|LAX`
## [1] 156
## 
## $`SEA|SFO`
## [1] 237

We proceed to add some node attributes to the MultiGraph using the nodeData method. Before node attributes can be added, we have to set a default value for each node attribute using the 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 "triangle" and that for the cities that connect with Seattle to the value "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")
## $BWI
## [1] "square"
## 
## $DEN
## [1] "circle"
## 
## $IAH
## [1] "circle"
## 
## $LAX
## [1] "circle"
## 
## $SEA
## [1] "triangle"
## 
## $SFO
## [1] "circle"

We then update the edge attribute 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 mgEdgeDataDefaults method. Subsequently, the 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")
## $`DEN|BWI`
## [1] "red"
## 
## $`IAH|DEN`
## [1] "red"
## 
## $`SEA|DEN`
## [1] "green"
## 
## $`DEN|IAH`
## [1] "red"
## 
## $`SEA|IAH`
## [1] "green"
## 
## $`SEA|LAX`
## [1] "green"
## 
## $`SFO|LAX`
## [1] "red"
## 
## $`LAX|SEA`
## [1] "red"
## 
## $`BWI|SFO`
## [1] "red"
## 
## $`SEA|SFO`
## [1] "green"

We are only interested in studying the fares for the airlines Alaska, United and Delta and hence would like to create a smaller MultiGraph object containing edge sets for only these airlines. This can be achieved using the 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 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 weight function that calculates the minimum of the fares as the input to the 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
## MultiGraph with 6 nodes and 1 edge sets
##             edge_set directed edge_count
##  Alaska_United_Delta     TRUE          5

The edge set by the edgeSetIntersect0 operation is named by concatenating the names of the edgeSets passed as input to the function.

mgEdgeData(gInt, "Alaska_United_Delta", attr= "weight")
## $`SEA|DEN`
## [1] 259
## 
## $`SEA|LAX`
## [1] 110
## 
## $`SFO|LAX`
## [1] 65
## 
## $`LAX|SEA`
## [1] 110
## 
## $`SEA|SFO`
## [1] 90

2.3 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 graph package as a list of data.frames containing information for from-gene, to-gene and the strength of interaction weight for each of the tissues studied.

We proceed to load the data for male and female mice.

data("esetsFemale") 
data("esetsMale") 
names(esetsFemale) 
## [1] "adipose" "brain"   "liver"   "muscle"
head(esetsFemale$brain)
##          from          to weight
## 1 10024404688 10024393150  0.853
## 2 10024406215 10024393156  0.513
## 3 10024411796 10024393163  1.000
## 4 10024415608 10024393167  0.727
## 5 10024399302 10024393196  0.342
## 6 10024399912 10024393196  0.555

The esetsFemale and esetsMale objects are a named 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 MultiGraph objects for the male and female data sets by making use of the 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 
## MultiGraph with 7081 nodes and 4 edge sets
##  edge_set directed edge_count
##   adipose     TRUE       1601
##     brain     TRUE       2749
##     liver     TRUE       3690
##    muscle     TRUE       3000
female
## MultiGraph with 7072 nodes and 4 edge sets
##  edge_set directed edge_count
##   adipose     TRUE       2108
##     brain     TRUE       2789
##     liver     TRUE       3584
##    muscle     TRUE       2777

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 RBGL package that we will use to find the edges that are connected to the gene ā€œ10024416717ā€ do not work directly with MultiGraph objects, we proceed to create graphBAM objects from the male and female edge sets for the brain tissue.

MultiGraph objects can be converted to a named list of graphBAM objects using the graphBAM method.

maleBrain <- extractGraphBAM(male, "brain")[["brain"]] 
maleBrain 
## A graphBAM graph with directed edges
## Number of Nodes = 7081 
## Number of Edges = 2749
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 bellman.ford.sp function from the RBGL package.

maleWt <- bellman.ford.sp(maleBrain, start = c("10024416717"))$distance 
maleWt <- maleWt[maleWt != Inf & maleWt !=0] 
maleWt
## 10024409301 10024409745 
##       0.636       1.389
femaleWt <- bellman.ford.sp(femaleBrain, start = c("10024416717"))$distance 
femaleWt <- femaleWt[femaleWt != Inf & femaleWt != 0] 
femaleWt
## 10024393904 10024409503 
##       0.789       0.866

For the subset of genes we identified, we proceed to add node attributes to our original 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 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 MultiGraph objects now contain the required node attributes for the subset of genes that we have narrowed our selection to.

For the MultiGraph objects for male and female, we are also interested in the genes that are common to both MultiGraphs. This can be calculated using the graphIntersect method.

resInt <- graphIntersect(male, female) 
resInt
## MultiGraph with 5699 nodes and 4 edge sets
##  edge_set directed edge_count
##   adipose     TRUE         88
##     brain     TRUE        473
##     liver     TRUE        455
##    muscle     TRUE        370

The operations we have dealt with so far only deal with manipulation of MultiGraph objects. Additional functions will need to be implemented for the visualization of the MultiGraph objects.

graph/inst/doc/clusterGraph.R0000644000175200017520000000170514516033233017210 0ustar00biocbuildbiocbuild## ----clustering, message=FALSE, warning=FALSE, error=FALSE-------------------- library("graph") library("cluster") data(ruspini) pm <- pam(ruspini, 4) cG <- new("clusterGraph", clusters = split(names(pm$clustering), pm$clustering)) nodes(cG) ## ----kmeans------------------------------------------------------------------- library(stats) km = kmeans(ruspini, 4) cG.km = new("clusterGraph", clusters=split(as.character(1:75), km$cluster)) inBoth = intersection(cG.km, cG) ## ----potential-use-for-distGraph---------------------------------------------- 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 } ## ----howmany------------------------------------------------------------------ sapply(rl, length) ## ----somecomps, echo=FALSE, results="hide"------------------------------------ dr = range(d1) rl.lens = sapply(rl[[4]], length) graph/inst/doc/clusterGraph.Rmd0000644000175200017520000000555414516003535017541 0ustar00biocbuildbiocbuild--- title: "How To use the clusterGraph and distGraph classes" author: - name: "Paul Villafuerte" affiliation: "Vignette translation from Sweave to Rmarkdown / HTML" date: "`r format(Sys.time(), '%B %d, %Y')`" vignette: > %\VignetteEngine{knitr::rmarkdown} %\VignetteIndexEntry{clusterGraph and distGraph} %\VignetteEncoding{UTF-8} %\VignetteDepends{graph, stats} %\VignetteKeywords{Graph, clustering, machine learning} %\VignettePackage{graph} output: BiocStyle::html_document: number_sections: true toc: true toc_depth: 4 --- # 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. # clusterGraph A *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. ```{r clustering, message=FALSE, warning=FALSE, error=FALSE} 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. ```{r kmeans} 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 `inBoth` is of length `r 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. # distGraph We use this same data to consider some potential uses for the `distGraph` class. Others have considered a similar structure for exploring clustering algorithms. ```{r potential-use-for-distGraph} 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 `rl` to see how the graph is being reduced. ```{r howmany} sapply(rl, length) ``` ```{r somecomps, echo=FALSE, results="hide"} 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 `r round(dr[1], 3)` to `r round(dr[2],3)`) there are still only `r length(rl[[4]])` connected components - one of which is of size `r max(rl.lens)`. graph/inst/doc/clusterGraph.html0000644000175200017520000232667714516033234020000 0ustar00biocbuildbiocbuild How To use the clusterGraph and distGraph classes

Contents

1 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.

2 clusterGraph

A 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)
##  [1] "1"  "2"  "3"  "4"  "5"  "6"  "7"  "8"  "9"  "10" "11" "12" "13" "14" "15"
## [16] "16" "17" "18" "19" "20" "21" "22" "23" "24" "25" "26" "27" "28" "29" "30"
## [31] "31" "32" "33" "34" "35" "36" "37" "38" "39" "40" "41" "42" "43" "44" "45"
## [46] "46" "47" "48" "49" "50" "51" "52" "53" "54" "55" "56" "57" "58" "59" "60"
## [61] "61" "62" "63" "64" "65" "66" "67" "68" "69" "70" "71" "72" "73" "74" "75"

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 inBoth is of length 1 indicating that there are that many distinct groups. One could, compute various measures of correspondence between the two clustering algorithms using the graph representation.

3 distGraph

We use this same data to consider some potential uses for the distGraph class. Others have considered a similar structure for exploring clustering algorithms.

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 rl to see how the graph is being reduced.

sapply(rl, length)
## [1]  3  3 11 36

We see that when we remove all distances that are bigger than 5 units (the range of distances was from 1.414 to 154.496) there are still only 36 connected components - one of which is of size 11.

graph/inst/doc/graph.R0000644000175200017520000000523314516033234015647 0ustar00biocbuildbiocbuild## ----g1, message=FALSE, warning=FALSE----------------------------------------- library(graph) set.seed(123) g1 = randomEGraph(LETTERS[1:15], edges = 100) g1 ## ----simplefuns, message=FALSE, warning=FALSE--------------------------------- nodes(g1) degree(g1) adj(g1, "A") acc(g1, c("E", "G")) ## ----subG, message=FALSE, warning=FALSE--------------------------------------- sg1 = subGraph(c("A", "E", "F", "L"), g1) boundary(sg1, g1) edges(sg1) edgeWeights(sg1) ## ----example1, message=FALSE, warning=FALSE----------------------------------- 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") ## ----addNodes, message=FALSE, warning=FALSE----------------------------------- 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) ## ----combine, message=FALSE, warning=FALSE------------------------------------ ##find the underlying graph ugraph(gR2) ## ----unions, message=FALSE, warning=FALSE------------------------------------- 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 ## ----randomEGraph, message=FALSE, warning=FALSE------------------------------- set.seed(333) V = letters[1:12] g1 = randomEGraph(V, .1) g1 g2 = randomEGraph(V, edges = 20) g2 ## ----randomGraph, message=FALSE, warning=FALSE-------------------------------- set.seed(23) V <- LETTERS[1:20] M <- 1:4 g1 <- randomGraph(V, M, .2) ## ----randomNodeGraph, eval = FALSE-------------------------------------------- # set.seed(123) # c1 <- c(1,1,2,4) # names(c1) <- letters[1:4] # g1 <- randomNodeGraph(c1) ## ----rGraph, message=FALSE, warning=FALSE------------------------------------- g1 g1cc <- connComp(g1) g1cc g1.sub <- subGraph(g1cc[[1]], g1) g1.sub ## ----dfs, message=FALSE, warning=FALSE---------------------------------------- DFS(gX2, "E") ## ----clusterGraph, message=FALSE, warning=FALSE------------------------------- cG1 <- new("clusterGraph", clusters = list(a = c(1, 2, 3), b = c(4, 5, 6))) cG1 acc(cG1, c("1", "2")) ## ----distanceGraph, message=FALSE, warning=FALSE------------------------------ set.seed(123) x <- rnorm(26) names(x) <- letters library(stats) d1 <- dist(x) g1 <- new("distGraph", Dist = d1) g1 graph/inst/doc/graph.Rmd0000644000175200017520000003405314516003535016173 0ustar00biocbuildbiocbuild--- title: "How to use the graph package" author: - name: "Aliyu Atiku Mustapha" affiliation: "Vignette translation from Sweave to Rmarkdown / HTML." date: "`r format(Sys.time(), '%B %d, %Y')`" package: graph vignette: > %\VignetteEngine{knitr::rmarkdown} %\VignetteIndexEntry{How to use the graph package} %\VignetteEncoding{UTF-8} %\VignetteKeywords{Graph} %\VignettePackage{graph} output: BiocStyle::html_document bibliography: references.bib link-citations: yes --- # Introduction The `r Biocpkg("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, `r Biocpkg("graph")` Provides the basic class definitions and functionality. `r Biocpkg("RBGL")` Provides an interface to graph algorithms (such as shortest path, connectivity etc). `r Biocpkg("Rgraphviz")` Provides rendering functionality. Different layout algorithms are provided and node plotting, line type, color etc parameters can be controlled by the user. 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 having the `r Biocpkg("Rgraphviz")` package available and from using it to render the different graphs as they proceed through these notes. # 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(random-graphs). First we attach the `r Biocpkg("graph")` package and create a random graph (this is based on the Erdos-Renyi model for random graphs). ```{r g1, message=FALSE, warning=FALSE} 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 `g1` we can find out which nodes are adjacent to it using the `adj` function. Or we can find out which nodes are accessible from it using the `acc` function. Both functions are *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 `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. ```{r simplefuns, message=FALSE, warning=FALSE} 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 `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 `edges` while the other retrieves the edge weights and is called `edgeWeights`. ```{r subG, message=FALSE, warning=FALSE} sg1 = subGraph(c("A", "E", "F", "L"), g1) boundary(sg1, g1) edges(sg1) edgeWeights(sg1) ``` ## Some Algebraic Manipulations The examples here originally came from Chris Volinsky at AT&T, but have been modified in places as the `r Biocpkg("graph")` package has evolved. In the code chunk below we demonstrate how to create a graph from scratch. In this code chunk two graphs are created, `gR` and `gR2`, the first is *undirected* while the second is a *directed graph*. ```{r example1, message=FALSE, warning=FALSE} 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 `addNode`, `addEdge`, `removeNode` and `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 `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 `clearNode` removes all edges to the specified nodes. ```{r addNodes, message=FALSE, warning=FALSE} 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 *underlying* graph. This is the graph with all edge orientation removed. The function `ugraph` provides this functionality. ```{r combine, message=FALSE, warning=FALSE} ##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 taken 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 the **same nodes** we define: `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. `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. `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. In the code chunk below we generate a random graph and then demonstrate the concepts of `union`, `intersection` and `complement`. ```{r unions, message=FALSE, warning=FALSE} 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 `gR` and `gR2` have different sets of edge weights these are lost when the `union`, `intersection` and `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. # Random Graphs Three basic strategies for finding random graphs have been implemented: `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. `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. `randomNodeGraph` A random graph with a pre-specified node distribution is generated. The function `randomEGraph` will generate graphs using the random edge model. In the code chunk below we generate a graph, `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 `g2` is on the same set of nodes but we specify that it will contain 20 edges. ```{r randomEGraph, message=FALSE, warning=FALSE} set.seed(333) V = letters[1:12] g1 = randomEGraph(V, .1) g1 g2 = randomEGraph(V, edges = 20) g2 ``` The function `randomGraph` generates graphs according to the latent variable model. In the code chunk below. ```{r randomGraph, message=FALSE, warning=FALSE} set.seed(23) V <- LETTERS[1:20] M <- 1:4 g1 <- randomGraph(V, M, .2) ``` Our last example involves generating random graphs with a pre-specified 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). ```{r randomNodeGraph, eval = FALSE} set.seed(123) c1 <- c(1,1,2,4) names(c1) <- letters[1:4] g1 <- randomNodeGraph(c1) ``` # Some Graph Algorithms In addition to the simple algebraic operations that we have demonstrated in the preceding 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 `r Biocpkg("RBGL")`. The function `connComp` returns a list of the connected components of the given graph. For a *directed graph* or *digraph* the underlying graph is the graph that results from removing all direction from the edges. This can be achieved using the function `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 `connComp`. ```{r rGraph, message=FALSE, warning=FALSE} 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 `r Biocpkg("graph")` package we have implemented the depth first searching algorithm as described in Algorithm 4.2.1 of @Algorithm_4_2_1. More efficient and comprehensive algorithms are available through the `r Biocpkg("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 edge weights along the path to that node. ```{r dfs, message=FALSE, warning=FALSE} DFS(gX2, "E") ``` # 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 `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. ```{r clusterGraph, message=FALSE, warning=FALSE} 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). ```{r distanceGraph, message=FALSE, warning=FALSE} set.seed(123) x <- rnorm(26) names(x) <- letters library(stats) d1 <- dist(x) g1 <- new("distGraph", Dist = d1) g1 ``` # 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 `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 `ftM2adjM` converts a *from-to* matrix into an adjacency matrix. Conversion to a `graphNEL` graph can be carried out using the `as` method for that class. An `aM` is an affiliation matrix which is frequently used in social networks analysis. The rows of `aM` represent actors, and the columns represent events. A one, 1, in the ith row and jth column represents the affiliation of the ith actor with the jth event. The function `aM2bpG` coerces a `aM` into an instance of the `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 `sparseM2Graph` and `graph2SparseM` provide coercion between `graphNEL` instances and sparse matrix representations. Currently we rely on the `r CRANpkg("SparseM")` of Koncker and Ng for the sparse matrix implementation. ## 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, `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 `edgemode` which can be either *directed* or *undirected* indicating whether the edges are directed or not. The class `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 `graphAM` is an adjacency matrix implementation. It will be developed next and will use the `r CRANpkg("SparseM")` package if it is available. The class `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. # Referencesgraph/inst/doc/graph.html0000644000175200017520000237233714516033235016431 0ustar00biocbuildbiocbuild How to use the graph package

Contents

1 Introduction

The 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,

graph Provides the basic class definitions and functionality.

RBGL Provides an interface to graph algorithms (such as shortest path, connectivity etc).

Rgraphviz Provides rendering functionality. Different layout algorithms are provided and node plotting, line type, color etc parameters can be controlled by the user.

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 having the Rgraphviz package available and from using it to render the different graphs as they proceed through these notes.

2 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 3.

First we attach the 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
## A graphNEL graph with undirected edges
## Number of Nodes = 15 
## Number of Edges = 100

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 g1 we can find out which nodes are adjacent to it using the adj function. Or we can find out which nodes are accessible from it using the acc function. Both functions are 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 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)
##  [1] "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O"
degree(g1)
##  A  B  C  D  E  F  G  H  I  J  K  L  M  N  O 
## 13 13 14 13 14 14 12 14 12 14 12 14 13 14 14
adj(g1, "A")
## $A
##  [1] "N" "M" "E" "I" "O" "G" "H" "D" "K" "J" "C" "L" "F"
acc(g1, c("E", "G"))
## $E
## A B C D F G H I J K L M N O 
## 1 1 1 1 1 1 1 1 1 1 1 1 1 1 
## 
## $G
## A B C D E F H I J K L M N O 
## 1 1 1 2 1 1 1 2 1 1 1 1 1 1

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 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 edges while the other retrieves the edge weights and is called edgeWeights.

sg1 = subGraph(c("A", "E", "F", "L"), g1)
boundary(sg1, g1)
## $A
##  [1] "C" "D" "G" "H" "I" "J" "K" "M" "N" "O"
## 
## $E
##  [1] "B" "C" "D" "G" "H" "I" "J" "K" "M" "N" "O"
## 
## $F
##  [1] "B" "C" "D" "G" "H" "I" "J" "K" "M" "N" "O"
## 
## $L
##  [1] "B" "C" "D" "G" "H" "I" "J" "K" "M" "N" "O"
edges(sg1)
## $A
## [1] "E" "L" "F"
## 
## $E
## [1] "A" "F" "L"
## 
## $F
## [1] "E" "A" "L"
## 
## $L
## [1] "E" "F" "A"
edgeWeights(sg1)
## $A
## E L F 
## 1 1 1 
## 
## $E
## A F L 
## 1 1 1 
## 
## $F
## E A L 
## 1 1 1 
## 
## $L
## E F A 
## 1 1 1

2.1 Some Algebraic Manipulations

The examples here originally came from Chris Volinsky at AT&T, but have been modified in places as the graph package has evolved. In the code chunk below we demonstrate how to create a graph from scratch. In this code chunk two graphs are created, gR and 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 addNode, addEdge, removeNode and 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 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 clearNode removes all edges to the specified nodes.

gX = addNode(c("E", "F"), gR)
gX
## A graphNEL graph with undirected edges
## Number of Nodes = 6 
## Number of Edges = 2
gX2 = addEdge(c("E", "F", "F"), c("A", "D", "E"), gX, c(1, 2, 3))
gX2
## A graphNEL graph with undirected edges
## Number of Nodes = 6 
## Number of Edges = 5
gR3 = combineNodes(c("A", "B"), gR, "W")
gR3
## A graphNEL graph with undirected edges
## Number of Nodes = 3 
## Number of Edges = 1
clearNode("A", gX)
## A graphNEL graph with undirected edges
## Number of Nodes = 6 
## Number of Edges = 1

When working with directed graphs it is sometimes of interest to find the underlying graph. This is the graph with all edge orientation removed. The function ugraph provides this functionality.

##find the underlying graph
ugraph(gR2)
## A graphNEL graph with undirected edges
## Number of Nodes = 4 
## Number of Edges = 3

Other operations that can be carried out on graphs, that are of some interest, are unions, intersections and complements. We have taken 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 the same nodes we define:

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.

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.

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.

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
## A graphNEL graph with undirected edges
## Number of Nodes = 4 
## Number of Edges = 2
x2 <- union(gR, gR3)
x2
## A graphNEL graph with undirected edges
## Number of Nodes = 4 
## Number of Edges = 4
x3 <- complement(gR)
x3
## A graphNEL graph with undirected edges
## Number of Nodes = 4 
## Number of Edges = 4

Notice that while the graphs gR and gR2 have different sets of edge weights these are lost when the union, intersection and 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.

3 Random Graphs

Three basic strategies for finding random graphs have been implemented:

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.

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.

randomNodeGraph A random graph with a pre-specified node distribution is generated.

The function randomEGraph will generate graphs using the random edge model. In the code chunk below we generate a graph, 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 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
## A graphNEL graph with undirected edges
## Number of Nodes = 12 
## Number of Edges = 7
g2 = randomEGraph(V, edges = 20)
g2
## A graphNEL graph with undirected edges
## Number of Nodes = 12 
## Number of Edges = 20

The function randomGraph generates graphs according to the latent variable model. In the code chunk below.

set.seed(23)
V <- LETTERS[1:20]
M <- 1:4
g1 <- randomGraph(V, M, .2)

Our last example involves generating random graphs with a pre-specified 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)

4 Some Graph Algorithms

In addition to the simple algebraic operations that we have demonstrated in the preceding 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 RBGL.

The function connComp returns a list of the connected components of the given graph. For a directed graph or digraph the underlying graph is the graph that results from removing all direction from the edges. This can be achieved using the function 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 connComp.

g1
## A graphNEL graph with undirected edges
## Number of Nodes = 20 
## Number of Edges = 58
g1cc <- connComp(g1)
g1cc
## [[1]]
## [1] "A"
## 
## [[2]]
##  [1] "B" "C" "D" "E" "F" "G" "I" "J" "M" "N" "O" "Q" "R" "S" "T"
## 
## [[3]]
## [1] "H"
## 
## [[4]]
## [1] "K"
## 
## [[5]]
## [1] "L"
## 
## [[6]]
## [1] "P"
g1.sub <- subGraph(g1cc[[1]], g1)
g1.sub
## A graphNEL graph with undirected edges
## Number of Nodes = 1 
## Number of Edges = 0

Another useful set of graph algorithms are the so-called searching algorithm. For the graph package we have implemented the depth first searching algorithm as described in Algorithm 4.2.1 of Gross and Yellen (2005). More efficient and comprehensive algorithms are available through the 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 edge weights along the path to that node.

DFS(gX2, "E")
## A B C D E F 
## 1 2 5 4 0 3

5 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 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
## A graph with  undirected  edges
## Number of Nodes = 6
## Number of Edges = 6
acc(cG1, c("1", "2"))
## $`1`
## [1] 1 2 3
## 
## $`2`
## [1] 1 2 3

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
## distGraph with 26 nodes

6 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 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 ftM2adjM converts a from-to matrix into an adjacency matrix. Conversion to a graphNEL graph can be carried out using the as method for that class.

An aM is an affiliation matrix which is frequently used in social networks analysis. The rows of aM represent actors, and the columns represent events. A one, 1, in the ith row and jth column represents the affiliation of the ith actor with the jth event. The function aM2bpG coerces a aM into an instance of the 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 sparseM2Graph and graph2SparseM provide coercion between graphNEL instances and sparse matrix representations. Currently we rely on the SparseM of Koncker and Ng for the sparse matrix implementation.

6.1 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, 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 edgemode which can be either directed or undirected indicating whether the edges are directed or not.

The class 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 graphAM is an adjacency matrix implementation. It will be developed next and will use the SparseM package if it is available.

The class 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.

References

Gross, J. L., and J. Yellen. 2005. Graph Theory and Its Applications. 2nd ed. Textbooks in Mathematics. CRC Press, Taylor & Francis Group. http://www.crcpress.com.

graph/inst/doc/graphAttributes.R0000644000175200017520000000612014516033236017714 0ustar00biocbuildbiocbuild## ----exampleGraph1, message=FALSE, results='hide'----------------------------- 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] ## ----exampleGraph2------------------------------------------------------------ (g1 <- graphAM(adjMat=mat)) ## ----foo, fig.cap="The graph `g1`.", fig.height=6, fig.small=TRUE, fig.width=6, echo=FALSE, message=FALSE, out.extra='id="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") } ## ----edgeDataDefaults1-------------------------------------------------------- edgeDataDefaults(g1) ## ----edgeDataDefaults2-------------------------------------------------------- edgeDataDefaults(g1, "weight") <- 1 edgeDataDefaults(g1, "code") <- "plain" edgeDataDefaults(g1) ## ----edgeDataDefaults3-------------------------------------------------------- edgeDataDefaults(g1, "weight") ## ----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") ## ----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") ## ----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") ## ----edgeData4---------------------------------------------------------------- edgeData(g1, from=f, to=t, attr="weight") <- c(11, 22) edgeData(g1, from=f, to=t, attr="weight") ## ----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") ## ----defaultNodeData1--------------------------------------------------------- nodeDataDefaults(g1) nodeDataDefaults(g1, attr="weight") <- 1 nodeDataDefaults(g1, attr="type") <- "vital" nodeDataDefaults(g1) nodeDataDefaults(g1, "weight") ## ----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") ## ----other, echo=FALSE-------------------------------------------------------- ## We need to reconcile this #g2 <- as(g1, "graphNEL") #edgeWeights(g2) graph/inst/doc/graphAttributes.Rmd0000644000175200017520000001264514516003535020245 0ustar00biocbuildbiocbuild--- title: "Attributes for Graph Objects" author: - name: "Seth Falcon" - name: "Paul Villafuerte" affiliation: "Vignette translation from Sweave to Rmarkdown / HTML" date: "`r format(Sys.time(), '%B %d, %Y')`" vignette: > %\VignetteIndexEntry{Attributes for Graph Objects} %\VignetteDepends{graph} %\VignetteKeywords{Graph} %\VignettePackage{graph} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} output: BiocStyle::html_document: number_sections: true toc: yes toc_depth: 4 --- # Introduction The `r Biocpkg('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 *graphAM-class* instance, however, any subclass of *graph-class* would work. See FigureĀ [1](#foo){reference-type="ref" reference="foo"}. ```{r exampleGraph1, message=FALSE, results='hide'} 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] ``` ```{r exampleGraph2} (g1 <- graphAM(adjMat=mat)) ``` ```{r foo, fig.cap="The graph `g1`.", fig.height=6, fig.small=TRUE, fig.width=6, echo=FALSE, message=FALSE, out.extra='id="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") } ``` # Edge Attributes ## 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 `edgeDataDefaults` method. A new graph instance will not have any edge attributes defined. ```{r edgeDataDefaults1} edgeDataDefaults(g1) ``` When a new edge attribute is defined, a default value must be specified. Here we will define two edge attributes: `weight` and `code` and specify a default value for each one. ```{r edgeDataDefaults2} 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 `edgeDataDefaults`. ```{r edgeDataDefaults3} edgeDataDefaults(g1, "weight") ``` ## Getting edge attributes Edge attributes are set and accessed using the `edgeData` method. Only attributes defined using `edgeDataDefaults` can be accessed using `edgeData`. If an attribute has not be set using `edgeData` for a given edge, then the default value is used. ```{r 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") ``` ## Setting edge attributes Attributes are set using the replacement form of `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. ```{r 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") ``` We can set the attributes for multiple edges to a single value. ```{r 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") ``` It is also possible to set multiple attributes to different values in a single call to `edgeData`. ```{r edgeData4} 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: ```{r 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") ``` # Node Attributes ## 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 `nodeDataDefaults` method. The interface is similar to `edgeDataDefaults`. ```{r defaultNodeData1} 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. ## Getting and setting node attributes Once a node attribute has been defined and given a default value using `nodeDataDefaults`, individual node attributes can be accessed using `nodeData`. ```{r 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") ``` ```{r other, echo=FALSE} ## We need to reconcile this #g2 <- as(g1, "graphNEL") #edgeWeights(g2) ``` graph/inst/doc/graphAttributes.html0000644000175200017520000257564214516033236020505 0ustar00biocbuildbiocbuild Attributes for Graph Objects

Contents

1 Introduction

The 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 graphAM-class instance, however, any subclass of graph-class would work. See FigureĀ 1.

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))
## A graphAM graph with undirected edges
## Number of Nodes = 4 
## Number of Edges = 5
The graph `g1`.

Figure 1: The graph g1

2 Edge Attributes

2.1 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 edgeDataDefaults method. A new graph instance will not have any edge attributes defined.

edgeDataDefaults(g1)
## list()

When a new edge attribute is defined, a default value must be specified. Here we will define two edge attributes: weight and code and specify a default value for each one.

edgeDataDefaults(g1, "weight") <- 1
edgeDataDefaults(g1, "code") <- "plain"
edgeDataDefaults(g1)
## $weight
## [1] 1
## 
## $code
## [1] "plain"

The default value for a particular attribute can be obtained by specifying the attribute name in the call to edgeDataDefaults.

edgeDataDefaults(g1, "weight")
## [1] 1

2.2 Getting edge attributes

Edge attributes are set and accessed using the edgeData method. Only attributes defined using edgeDataDefaults can be accessed using edgeData. If an attribute has not be set using edgeData for a given edge, then the default value is used.

edgeData(g1, from="a", to="d", attr="weight")
## $`a|d`
## [1] 1
edgeData(g1, from="a", attr="weight")
## $`a|c`
## [1] 1
## 
## $`a|d`
## [1] 1
edgeData(g1, to="a", attr="weight")
## $`c|a`
## [1] 1
## 
## $`d|a`
## [1] 1
allAttrsAllEdges <- edgeData(g1)
weightAttrAllEdges <- edgeData(g1, attr="weight")

2.3 Setting edge attributes

Attributes are set using the replacement form of 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")
## $`a|c`
## [1] 1
## 
## $`a|d`
## [1] 2
edgeData(g1, from="a", attr="code")
## $`a|c`
## [1] "fancy"
## 
## $`a|d`
## [1] "fancy"

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")
## $`a|c`
## [1] 10
## 
## $`b|c`
## [1] 10

It is also possible to set multiple attributes to different values in a single call to edgeData.

edgeData(g1, from=f, to=t, attr="weight") <- c(11, 22)
edgeData(g1, from=f, to=t, attr="weight")
## $`a|c`
## [1] 11
## 
## $`b|c`
## [1] 22

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")
## $`a|d`
##  [1]  1  2  3  4  5  6  7  8  9 10
edgeData(g1, from=f, to=t, attr="weight")
## $`a|c`
## [1] "a" "c" "e"
## 
## $`b|c`
## [1] "b" "c" "e"

3 Node Attributes

3.1 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 nodeDataDefaults method. The interface is similar to edgeDataDefaults.

nodeDataDefaults(g1)
## list()
nodeDataDefaults(g1, attr="weight") <- 1
nodeDataDefaults(g1, attr="type") <- "vital"
nodeDataDefaults(g1)
## $weight
## [1] 1
## 
## $type
## [1] "vital"
nodeDataDefaults(g1, "weight")
## [1] 1

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.

3.2 Getting and setting node attributes

Once a node attribute has been defined and given a default value using nodeDataDefaults, individual node attributes can be accessed using nodeData.

nodeData(g1, n="a")
## $a
## $a$weight
## [1] 1
## 
## $a$type
## [1] "vital"
nodeData(g1, n="a", attr="weight") <- 100
nodeData(g1, n=c("a", "b"), attr="weight")
## $a
## [1] 100
## 
## $b
## [1] 1
nodeData(g1, n=c("a", "b"), attr="weight") <- 500
nodeData(g1, n=c("a", "b"), attr="weight")
## $a
## [1] 500
## 
## $b
## [1] 500
nodeData(g1, n=c("a", "b"), attr="weight") <- c(11, 22)
nodeData(g1, n=c("a", "b"), attr="weight")
## $a
## [1] 11
## 
## $b
## [1] 22
graph/inst/perf/0000755000175200017520000000000014516003535014610 5ustar00biocbuildbiocbuildgraph/inst/perf/Makefile0000644000175200017520000000035414516033236016253 0ustar00biocbuildbiocbuildBASE = 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/bgt.R0000644000175200017520000000620214516003535015507 0ustar00biocbuildbiocbuild## 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/graphperf.Rnw0000644000175200017520000002475514516003535017273 0ustar00biocbuildbiocbuild\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/perf/multigraphs.Rnw0000644000175200017520000000450114516003535017637 0ustar00biocbuildbiocbuild\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/unitTests/0000755000175200017520000000000014516003535015656 5ustar00biocbuildbiocbuildgraph/inst/unitTests/MultiGraph_test.R0000644000175200017520000013324514516003535021124 0ustar00biocbuildbiocbuildset.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/attrData_test.R0000644000175200017520000001145214516003535020607 0ustar00biocbuildbiocbuildbasicProps <- 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/clusterGraph_test.R0000644000175200017520000000057114516003535021506 0ustar00biocbuildbiocbuildbasicCluserGraph <- 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/degree_test.R0000644000175200017520000000223414516003535020274 0ustar00biocbuildbiocbuildlibrary("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"]]) } test_handshaking = function() { ge1 = graphExamples[[1]] checkEquals(sum(degree(ge1)), 2*ncol(edgeMatrix(ge1))) # handshaking } test_degree_self = function() { ge1 = graphExamples[[1]] # 16 edges checkEquals(ncol(edgeMatrix(ge1)), 16) ge2 = addEdge("j", "j", ge1) checkEquals(ncol(edgeMatrix(ge2)), 17) checkEquals(sum(degree(ge2)), 34) } test_degree_nodes = function() { g <- graphBAM(data.frame(from=letters[1:10], to=letters[2:11], weight=rep(1, 10))) dd <- degree(g, letters[1:2]) checkEquals(dd, c(a = 1, b = 2)) } graph/inst/unitTests/edgeWeights_test.R0000644000175200017520000000340514516003535021301 0ustar00biocbuildbiocbuildegGraphAM <- 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/graphAM_test.R0000644000175200017520000004215314516003535020364 0ustar00biocbuildbiocbuildsimpleAdjMat <- 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/graphBAM_test.R0000644000175200017520000017173114516003535020473 0ustar00biocbuildbiocbuild## 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/graphNEL_test.R0000644000175200017520000003252114516003535020503 0ustar00biocbuildbiocbuild ##.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/gxl_test.R0000644000175200017520000000350414516003535017634 0ustar00biocbuildbiocbuildsimpleWithAttributes <- 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/leaves_test.R0000644000175200017520000000122414516003535020316 0ustar00biocbuildbiocbuildlibrary("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/nodeAndEdgeData_test.R0000644000175200017520000002267214516003535022000 0ustar00biocbuildbiocbuild# # 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/setbit_test.R0000644000175200017520000000636514516003535020344 0ustar00biocbuildbiocbuild.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/unitTests/simple_sparse_test.R0000644000175200017520000000141514516003535021707 0ustar00biocbuildbiocbuild.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/man/0000755000175200017520000000000014516003535013452 5ustar00biocbuildbiocbuildgraph/man/DFS.Rd0000644000175200017520000000313314516003535014355 0ustar00biocbuildbiocbuild\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/IMCA.Rd0000644000175200017520000000404514516003535014455 0ustar00biocbuildbiocbuild\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/MAPKsig.Rd0000644000175200017520000000151214516003535015173 0ustar00biocbuildbiocbuild\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/MultiGraph-class.Rd0000644000175200017520000002636314516003535017132 0ustar00biocbuildbiocbuild\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/acc-methods.Rd0000644000175200017520000000317114516003535016132 0ustar00biocbuildbiocbuild\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/addEdge.Rd0000644000175200017520000000275514516003535015267 0ustar00biocbuildbiocbuild\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/addNode.Rd0000644000175200017520000000342714516003535015305 0ustar00biocbuildbiocbuild\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/adj-methods.Rd0000644000175200017520000000176414516003535016150 0ustar00biocbuildbiocbuild\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/adjacencyMatrix.Rd0000644000175200017520000000213214516003535017045 0ustar00biocbuildbiocbuild\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/apoptosisGraph.Rd0000644000175200017520000000270314516003535016746 0ustar00biocbuildbiocbuild\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/attrData-class.Rd0000644000175200017520000000566314516003535016622 0ustar00biocbuildbiocbuild\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/attrDataItem-methods.Rd0000644000175200017520000000245514516003535017773 0ustar00biocbuildbiocbuild\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/attrDefaults-methods.Rd0000644000175200017520000000172614516003535020052 0ustar00biocbuildbiocbuild\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/aveNumEdges.Rd0000644000175200017520000000116714516003535016151 0ustar00biocbuildbiocbuild\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/biocRepos.Rd0000644000175200017520000000073214516003535015670 0ustar00biocbuildbiocbuild\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/man/boundary.Rd0000644000175200017520000000271614516003535015572 0ustar00biocbuildbiocbuild\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/calcProb.Rd0000644000175200017520000000136614516003535015474 0ustar00biocbuildbiocbuild\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/calcSumProb.Rd0000644000175200017520000000332514516003535016156 0ustar00biocbuildbiocbuild\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/clearNode.Rd0000644000175200017520000000141114516003535015632 0ustar00biocbuildbiocbuild\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/clusterGraph-class.Rd0000644000175200017520000000463614516003535017520 0ustar00biocbuildbiocbuild\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/clusteringCoefficient-methods.Rd0000644000175200017520000000300114516003535021712 0ustar00biocbuildbiocbuild\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/combineNodes.Rd0000644000175200017520000000342414516003535016351 0ustar00biocbuildbiocbuild\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/defunct.Rd0000644000175200017520000000061514516003535015373 0ustar00biocbuildbiocbuild\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/distGraph-class.Rd0000644000175200017520000000444414516003535016777 0ustar00biocbuildbiocbuild\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/duplicatedEdges.Rd0000644000175200017520000000153014516003535017026 0ustar00biocbuildbiocbuild\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/edgeData-methods.Rd0000644000175200017520000000163414516003535017104 0ustar00biocbuildbiocbuild\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/edgeDataDefaults-methods.Rd0000644000175200017520000000123314516003535020567 0ustar00biocbuildbiocbuild\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/edgeMatrix.Rd0000644000175200017520000000522214516003535016033 0ustar00biocbuildbiocbuild\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/edgeSets.Rd0000644000175200017520000000146114516003535015506 0ustar00biocbuildbiocbuild\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/edgeWeights.Rd0000644000175200017520000001034214516003535016200 0ustar00biocbuildbiocbuild\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/fromGXL-methods.Rd0000644000175200017520000000636614516003535016733 0ustar00biocbuildbiocbuild\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/graph-class.Rd0000644000175200017520000002274014516003535016152 0ustar00biocbuildbiocbuild\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/graph2SparseM.Rd0000644000175200017520000000350514516003535016422 0ustar00biocbuildbiocbuild\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/graphAM-class.Rd0000644000175200017520000001225414516003535016367 0ustar00biocbuildbiocbuild\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/graphBAM-class.Rd0000644000175200017520000002652014516003535016472 0ustar00biocbuildbiocbuild\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/graphExamples.Rd0000644000175200017520000000064514516003535016546 0ustar00biocbuildbiocbuild\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/graphNEL-class.Rd0000644000175200017520000001447314516003535016515 0ustar00biocbuildbiocbuild\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/inEdges.Rd0000644000175200017520000000216314516003535015321 0ustar00biocbuildbiocbuild\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/internal.Rd0000644000175200017520000000037014516003535015555 0ustar00biocbuildbiocbuild\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/isAdjacent-methods.Rd0000644000175200017520000000153414516003535017452 0ustar00biocbuildbiocbuild\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/isDirected-methods.Rd0000644000175200017520000000071014516003535017457 0ustar00biocbuildbiocbuild\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/leaves.Rd0000644000175200017520000000174414516003535015226 0ustar00biocbuildbiocbuild\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/listEdges.Rd0000644000175200017520000000223614516003535015667 0ustar00biocbuildbiocbuild\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/matrix2Graph.Rd0000644000175200017520000000772014516003535016317 0ustar00biocbuildbiocbuild\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/mostEdges.Rd0000644000175200017520000000145014516003535015673 0ustar00biocbuildbiocbuild\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/multigraph.Rd0000644000175200017520000000362714516003535016125 0ustar00biocbuildbiocbuild\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/nodeData-methods.Rd0000644000175200017520000000155614516003535017130 0ustar00biocbuildbiocbuild\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/nodeDataDefaults-methods.Rd0000644000175200017520000000155114516003535020613 0ustar00biocbuildbiocbuild\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/numNoEdges.Rd0000644000175200017520000000114414516003535016005 0ustar00biocbuildbiocbuild\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/pancrCaIni.Rd0000644000175200017520000000153114516003535015750 0ustar00biocbuildbiocbuild\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/randomEGraph.Rd0000644000175200017520000000253114516003535016311 0ustar00biocbuildbiocbuild\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/randomGraph.Rd0000644000175200017520000000355214516003535016210 0ustar00biocbuildbiocbuild\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/randomNodeGraph.Rd0000644000175200017520000000216514516003535017015 0ustar00biocbuildbiocbuild\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/removeEdge.Rd0000644000175200017520000000222714516003535016026 0ustar00biocbuildbiocbuild\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/removeNode.Rd0000644000175200017520000000220614516003535016044 0ustar00biocbuildbiocbuild\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/renderInfo-class.Rd0000644000175200017520000001270514516003535017144 0ustar00biocbuildbiocbuild\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/reverseEdgeDirections.Rd0000644000175200017520000000164414516003535020232 0ustar00biocbuildbiocbuild\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/settings.Rd0000644000175200017520000000221114516003535015575 0ustar00biocbuildbiocbuild\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/simpleEdge-class.Rd0000644000175200017520000000216714516003535017130 0ustar00biocbuildbiocbuild\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.Rd0000644000175200017520000000251014516003535017175 0ustar00biocbuildbiocbuild\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/subGraph.Rd0000644000175200017520000000224714516003535015521 0ustar00biocbuildbiocbuild\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/toDotR-methods.Rd0000644000175200017520000000620214516003535016615 0ustar00biocbuildbiocbuild\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/toDotWithRI.Rd0000644000175200017520000000456314516003535016131 0ustar00biocbuildbiocbuild\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/ugraph.Rd0000644000175200017520000000233614516003535015233 0ustar00biocbuildbiocbuild\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/validGraph.Rd0000644000175200017520000000142214516003535016021 0ustar00biocbuildbiocbuild\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/write.tlp.Rd0000644000175200017520000000101614516003535015667 0ustar00biocbuildbiocbuild\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/src/0000755000175200017520000000000014516033236013467 5ustar00biocbuildbiocbuildgraph/src/Makevars0000644000175200017520000000031714516003535015163 0ustar00biocbuildbiocbuildafter: $(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/src/graph.c0000644000175200017520000007235414516003535014746 0ustar00biocbuildbiocbuild#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/tests/0000755000175200017520000000000014516003535014041 5ustar00biocbuildbiocbuildgraph/tests/graph_unit_tests.R0000644000175200017520000000006714516003535017551 0ustar00biocbuildbiocbuildBiocGenerics:::testPackage("graph", pattern="_test.R") graph/vignettes/0000755000175200017520000000000014516033236014710 5ustar00biocbuildbiocbuildgraph/vignettes/GraphClass.Rmd0000644000175200017520000002521714516003535017411 0ustar00biocbuildbiocbuild--- title: "Graph Design" author: - name: "R. Gentleman" - name: "Elizabeth Whalen" - name: "W. Huber" - name: "S. Falcon" - name: "Halimat C. Atanda" affiliation: "Vignette translation from Sweave to Rmarkdown / HTML" date: "`r format(Sys.Date(), '%B %d %Y')`" package: graph output: BiocStyle::html_document vignette: > %\VignetteIndexEntry{Graph Design} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- # Introduction The purpose of this document is to describe the implementation of the classes used to represent graphs in the *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 *graph* package and define the set of methods that form the *graph interface* as determined empirically by the methods used by packages like `r Biocpkg("RBGL")` when interacting with *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 *simple graph* is a graph with at most one edge between any pair of nodes and no self-loops. # The *graph* class The *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, a node, or 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. *This raises the question of whether we should use the AnnotatedDataFrame class from* `r Biocpkg("Biobase")` *here as a way to implement general node and edge attributes.* *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 *graph* class itself is VIRTUAL and has the following definition: ```{r message=FALSE} library("graph") ``` ```{r} getClass("graph") ``` The `edgemode` slot indicates whether the graph is *directed* or *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 `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 `isDirected` do the right thing. The `edgeData` and `nodeData` slots store the attributes for the edges and nodes of the graph, respectively. There are currently implementations for the *graphNEL* class, where nodes are a vector and edges are a list, each element of the list corresponds 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 *graphAM* class stores the edge information in an adjacent 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. The first is *distGraph*, which takes a distance matrix directly and has special thresholding capabilities. It is not clear whether this should be a specialization of the *graphAM* class or not. The second specialized class is a *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 `undirected`. If the edgemode is reset, then coercion to some other mode of graph is needed. ## Methods of graphs Here are some of the methods that all graph-like objects should support: `nodes(object)` Returns a character vector of the node labels. The order is not defined. `nodes<-(object)` Returns a new graph object with the node labels set as specified by a character vector. This is slightly fragile since the order matters. But the order can only really be determined by first calling the _R_ function, `nodes`, and then providing a character vector of the appropriate length. `addNode(node, object, edges)` Returns a new graph object with additional nodes and (optionally) edges. The methods that have been implemented expect `node` to be the node labels of the new nodes specified as a character vector. Optional edges can be specified. `removeNode(node, object)` Returns a new graph object with nodes (and their incident edges) removed. Current methods are implemented for `node` being a character vector of node labels to remove. `edges(object, which)` Returns 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. `edgeWeights(object, index)` `addEdge(from, to, graph, weights)` Returns a new graph object with additional edges. `removeEdge(from, to, graph)` Returns a new graph object with the specified edges removed. `numNodes(object)` Returns a count of the nodes in the graph. `numEdges(object)` Returns a count of the edges in the graph. `isDirected(object)` Returns TRUE if the graph is directed, and FALSE otherwise. `acc(object, index)` See man page. `adj(object, index)` See man page. `nodeData` Access to node attributes. See man page. `edgeData` Access to edge attributes. See man page. ## 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 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. ### Representation of Edges 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 *graphNEL* class, we do not store the names of the nodes in the NEL, but rather index 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 it means that knowledge of the edges does not provide knowledge of the nodes. # Multi-graphs There are no clear and widely used definitions for multi-graphs. So here, we will make a clear definition that we believe will be useful for biological computations. We define a multi-graph as a graph that consists 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 *directed* or *undirected* and self-loops are allowed. It is not clear whether there should be distinct types of multi-graphs 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 *graph* class. The definition is: ```{r} getClass("multiGraph") ``` `nodes` A vector of node identifiers. `edgeL` A possibly named list of instances of the *edgeSet* class. The *edgeSet* class is a virtual class with several different extensions. These include a *edgeSetNEL* and an *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. ## Methods In some ways, it would be most natural to have `edges` methods for the *edgeSet* class. The issues raised in Section 2.2.1 seem to preclude this and it only seems to make sense to have `node` and `edges` methods for the *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. ## Use Cases An important motivator for the *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. # 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$. graph/vignettes/MultiGraphClass.Rmd0000644000175200017520000004133014516003535020416 0ustar00biocbuildbiocbuild--- title: "graphBAM and MultiGraph classes" author: - name: "N. Gopalakrishnan" - name: "Halimat C. Atanda" affiliation: "Vignette translation from Sweave to Rmarkdown / HTML" date: "`r format(Sys.Date(), '%B %d %Y')`" package: graph output: BiocStyle::html_document vignette: > %\VignetteIndexEntry{graphBAM and MultiGraph Classes} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- # graphBAM class ## Introduction The *graphBAM* class has been created as a more efficient replacement for the *graphAM* class in the *graph* package. The adjacency matrix in the *graphBAM* class is represented as a bit array using a `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 *graph* package which provides the class definition and methods for the *graphBAM* class. ```{r message=FALSE} library(graph) ``` One of the arguments `df` to the *graphBAM* constructor is a `data.frame` containing three columns: "from","to" and "weight", each row in the `data.frame` representing an edge in the graph. The `from` and `to` columns can be character vectors or factors, while the `weight` column must be a numeric vector. The argument `nodes` are calculated from the unique names in the `from` and `to` columns of the `data.frame`. The argument `edgeMode` should be a character vector, either "directed" or "undirected" indicating whether the graph represented should be directed or undirected respectively. ## A simple graph represented using graphBAM class We proceed to represent a simple graph using the *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 (`from`) to the destination city (`to`). The weight represents the fare for flying between the `from` and `to` cities. ```{r} 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 *graph* object as well as the stored fares(`weight`) can be obtained using the `nodes` and `edgeWeights` methods respectively. ```{r} nodes(g) edgeWeights(g, index = c("SEA", "LAX")) ``` Additional nodes or edges can be added to our graph using the `addNode` and `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. ```{r} 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 `removeNode` and `removeEdge` methods respectively. We proceed to remove the flight connection from "DEN" to "IAH" and subsequently the node "IAH". ```{r} 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 `subGraph` method. ```{r} g <- subGraph(snodes = c("DEN","LAX", "SEA"), g) g ``` We can extract the `from`-`to` relationships for our graph using the `extractFromTo` method. ```{r} extractFromTo(g) ``` ## 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 *graph* package as a list of `data.frame`s containing information for `from-gene`, `to-gene` and the strength of interaction `weight` for each of the tissues studied. We proceed to load the data for male and female mice. ```{r} 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 *graphBAM* objects for male and female mice. ```{r} dfMale <- esetsMale[["brain"]] dfFemale <- esetsFemale[["brain"]] head(dfMale) ``` ```{r} 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 `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 `sum` as the function for handling weights to the `edgeFun` argument. The `edgeFun` argument should be passed a list of named functions corresponding to the edge attributes to be handled during the intersection process. ```{r} intrsct <- graphIntersect(male, female, edgeFun=list(weight = sum)) intrsct ``` If node attributes were present in the `graphBAM` objects, a list of named function could be passed as input to the `graphIntersect` method for handling them during the intersection process. We proceed to remove edges from the `graphBAM` result we just calculated with a weight attribute less than a numeric value of 0.8 using the `removeEdgesByWeight` method. ```{r} 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 `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 `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 `resWt` graph using the `extractFromTo` method and then make use of the `edgeData` method to update the "color" edge attribute. ```{r} 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" ``` # MultiGraphs ## Introduction The *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 `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 *MultiGraph* class representation (i.e. the from-node is the same as the to-node). The *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 `r Biocpkg("graph")` and `r Biocpkg("RBGL")` packages that we will be using. We will then create a *MultiGraph* object and then spend some time examining some of the different functions that can be applied to *MultiGraph* objects. ```{r message=FALSE} library(graph) library(RBGL) ``` ## A simple MultiGraph example We proceed to construct a *MultiGraph* object with directed `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 *MultiGraph* and we have one `edgeSet` each for the airlines. Each `edgeSet` represents the flight connections from an originating city(`from`) to the destination city(`to`). The weight represents the fare for flying between the `from` and `to` cities. For each airline, we proceed to create a *data.frame* containing the originating city, the destination city and the fare. ```{r} 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 *MultiGraph* class constructor as a named `list`, each member of the list being a `data.frame` for an airline. A logical vector passed to the `directed` argument of the *MultiGraph* constructor indicates whether the `MultiGraph` to be created should have directed or undirected edge sets. ```{r} esets <- list(Alaska = ft1, United = ft2, Delta = ft3, American = ft4) mg <- MultiGraph(esets, directed = TRUE) mg ``` The nodes (cities) of the *MultiGraph* object can be obtained by using the `nodes` method. ```{r} nodes(mg) ``` To find the fares for all the flights that originate from SEA for the Delta airline, we can use the `mgEdgeData` method. ```{r} mgEdgeData(mg, "Delta", from = "SEA", attr = "weight") ``` We proceed to add some node attributes to the `MultiGraph` using the `nodeData` method. Before node attributes can be added, we have to set a default value for each node attribute using the `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 `"triangle"` and that for the cities that connect with Seattle to the value `"circle"`. ```{r} 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". ```{r} nodeData(mg, attr = "shape") ``` We then update the edge attribute `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 `mgEdgeDataDefaults` method. Subsequently, the `megEdgeData<-` method can be used to update specific edge attributes. ```{r} 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 *MultiGraph* object containing edge sets for only these airlines. This can be achieved using the `subsetEdgeSets` method. ```{r} 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 `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 `weight` function that calculates the minimum of the fares as the input to the `edgeSetIntersect0` method. (The user has the option of specifying any function for appropriate handling of edge attributes ). ```{r} edgeFun <- list( weight = min) gInt <- edgeSetIntersect0(g, edgeFun = edgeFun) gInt ``` The edge set by the `edgeSetIntersect0` operation is named by concatenating the names of the edgeSets passed as input to the function. ```{r} mgEdgeData(gInt, "Alaska_United_Delta", attr= "weight") ``` ## 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 *graph* package as a list of `data.frame`s containing information for `from-gene`, `to-gene` and the strength of interaction `weight` for each of the tissues studied. We proceed to load the data for male and female mice. ```{r} data("esetsFemale") data("esetsMale") names(esetsFemale) head(esetsFemale$brain) ``` The `esetsFemale` and `esetsMale` objects are a named `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 *MultiGraph* objects for the male and female data sets by making use of the *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. ```{r} 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 `r Biocpkg("RBGL")` package that we will use to find the edges that are connected to the gene "10024416717" do not work directly with *MultiGraph* objects, we proceed to create `graphBAM` objects from the male and female edge sets for the brain tissue. *MultiGraph* objects can be converted to a named list of `graphBAM` objects using the `graphBAM` method. ```{r} 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 `bellman.ford.sp` function from the `r Biocpkg("RBGL")` package. ```{r} 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 `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 attribute of "gray". ```{r} 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 `MultiGraph` objects now contain the required node attributes for the subset of genes that we have narrowed our selection to. For the `MultiGraph` objects for male and female, we are also interested in the genes that are common to both `MultiGraph`s. This can be calculated using the `graphIntersect` method. ```{r} resInt <- graphIntersect(male, female) resInt ``` The operations we have dealt with so far only deal with manipulation of *MultiGraph* objects. Additional functions will need to be implemented for the visualization of the *MultiGraph* objects.graph/vignettes/clusterGraph.Rmd0000644000175200017520000000555414516003535020027 0ustar00biocbuildbiocbuild--- title: "How To use the clusterGraph and distGraph classes" author: - name: "Paul Villafuerte" affiliation: "Vignette translation from Sweave to Rmarkdown / HTML" date: "`r format(Sys.time(), '%B %d, %Y')`" vignette: > %\VignetteEngine{knitr::rmarkdown} %\VignetteIndexEntry{clusterGraph and distGraph} %\VignetteEncoding{UTF-8} %\VignetteDepends{graph, stats} %\VignetteKeywords{Graph, clustering, machine learning} %\VignettePackage{graph} output: BiocStyle::html_document: number_sections: true toc: true toc_depth: 4 --- # 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. # clusterGraph A *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. ```{r clustering, message=FALSE, warning=FALSE, error=FALSE} 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. ```{r kmeans} 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 `inBoth` is of length `r 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. # distGraph We use this same data to consider some potential uses for the `distGraph` class. Others have considered a similar structure for exploring clustering algorithms. ```{r potential-use-for-distGraph} 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 `rl` to see how the graph is being reduced. ```{r howmany} sapply(rl, length) ``` ```{r somecomps, echo=FALSE, results="hide"} 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 `r round(dr[1], 3)` to `r round(dr[2],3)`) there are still only `r length(rl[[4]])` connected components - one of which is of size `r max(rl.lens)`. graph/vignettes/graph.Rmd0000644000175200017520000003405314516003535016461 0ustar00biocbuildbiocbuild--- title: "How to use the graph package" author: - name: "Aliyu Atiku Mustapha" affiliation: "Vignette translation from Sweave to Rmarkdown / HTML." date: "`r format(Sys.time(), '%B %d, %Y')`" package: graph vignette: > %\VignetteEngine{knitr::rmarkdown} %\VignetteIndexEntry{How to use the graph package} %\VignetteEncoding{UTF-8} %\VignetteKeywords{Graph} %\VignettePackage{graph} output: BiocStyle::html_document bibliography: references.bib link-citations: yes --- # Introduction The `r Biocpkg("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, `r Biocpkg("graph")` Provides the basic class definitions and functionality. `r Biocpkg("RBGL")` Provides an interface to graph algorithms (such as shortest path, connectivity etc). `r Biocpkg("Rgraphviz")` Provides rendering functionality. Different layout algorithms are provided and node plotting, line type, color etc parameters can be controlled by the user. 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 having the `r Biocpkg("Rgraphviz")` package available and from using it to render the different graphs as they proceed through these notes. # 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(random-graphs). First we attach the `r Biocpkg("graph")` package and create a random graph (this is based on the Erdos-Renyi model for random graphs). ```{r g1, message=FALSE, warning=FALSE} 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 `g1` we can find out which nodes are adjacent to it using the `adj` function. Or we can find out which nodes are accessible from it using the `acc` function. Both functions are *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 `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. ```{r simplefuns, message=FALSE, warning=FALSE} 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 `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 `edges` while the other retrieves the edge weights and is called `edgeWeights`. ```{r subG, message=FALSE, warning=FALSE} sg1 = subGraph(c("A", "E", "F", "L"), g1) boundary(sg1, g1) edges(sg1) edgeWeights(sg1) ``` ## Some Algebraic Manipulations The examples here originally came from Chris Volinsky at AT&T, but have been modified in places as the `r Biocpkg("graph")` package has evolved. In the code chunk below we demonstrate how to create a graph from scratch. In this code chunk two graphs are created, `gR` and `gR2`, the first is *undirected* while the second is a *directed graph*. ```{r example1, message=FALSE, warning=FALSE} 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 `addNode`, `addEdge`, `removeNode` and `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 `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 `clearNode` removes all edges to the specified nodes. ```{r addNodes, message=FALSE, warning=FALSE} 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 *underlying* graph. This is the graph with all edge orientation removed. The function `ugraph` provides this functionality. ```{r combine, message=FALSE, warning=FALSE} ##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 taken 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 the **same nodes** we define: `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. `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. `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. In the code chunk below we generate a random graph and then demonstrate the concepts of `union`, `intersection` and `complement`. ```{r unions, message=FALSE, warning=FALSE} 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 `gR` and `gR2` have different sets of edge weights these are lost when the `union`, `intersection` and `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. # Random Graphs Three basic strategies for finding random graphs have been implemented: `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. `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. `randomNodeGraph` A random graph with a pre-specified node distribution is generated. The function `randomEGraph` will generate graphs using the random edge model. In the code chunk below we generate a graph, `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 `g2` is on the same set of nodes but we specify that it will contain 20 edges. ```{r randomEGraph, message=FALSE, warning=FALSE} set.seed(333) V = letters[1:12] g1 = randomEGraph(V, .1) g1 g2 = randomEGraph(V, edges = 20) g2 ``` The function `randomGraph` generates graphs according to the latent variable model. In the code chunk below. ```{r randomGraph, message=FALSE, warning=FALSE} set.seed(23) V <- LETTERS[1:20] M <- 1:4 g1 <- randomGraph(V, M, .2) ``` Our last example involves generating random graphs with a pre-specified 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). ```{r randomNodeGraph, eval = FALSE} set.seed(123) c1 <- c(1,1,2,4) names(c1) <- letters[1:4] g1 <- randomNodeGraph(c1) ``` # Some Graph Algorithms In addition to the simple algebraic operations that we have demonstrated in the preceding 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 `r Biocpkg("RBGL")`. The function `connComp` returns a list of the connected components of the given graph. For a *directed graph* or *digraph* the underlying graph is the graph that results from removing all direction from the edges. This can be achieved using the function `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 `connComp`. ```{r rGraph, message=FALSE, warning=FALSE} 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 `r Biocpkg("graph")` package we have implemented the depth first searching algorithm as described in Algorithm 4.2.1 of @Algorithm_4_2_1. More efficient and comprehensive algorithms are available through the `r Biocpkg("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 edge weights along the path to that node. ```{r dfs, message=FALSE, warning=FALSE} DFS(gX2, "E") ``` # 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 `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. ```{r clusterGraph, message=FALSE, warning=FALSE} 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). ```{r distanceGraph, message=FALSE, warning=FALSE} set.seed(123) x <- rnorm(26) names(x) <- letters library(stats) d1 <- dist(x) g1 <- new("distGraph", Dist = d1) g1 ``` # 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 `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 `ftM2adjM` converts a *from-to* matrix into an adjacency matrix. Conversion to a `graphNEL` graph can be carried out using the `as` method for that class. An `aM` is an affiliation matrix which is frequently used in social networks analysis. The rows of `aM` represent actors, and the columns represent events. A one, 1, in the ith row and jth column represents the affiliation of the ith actor with the jth event. The function `aM2bpG` coerces a `aM` into an instance of the `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 `sparseM2Graph` and `graph2SparseM` provide coercion between `graphNEL` instances and sparse matrix representations. Currently we rely on the `r CRANpkg("SparseM")` of Koncker and Ng for the sparse matrix implementation. ## 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, `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 `edgemode` which can be either *directed* or *undirected* indicating whether the edges are directed or not. The class `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 `graphAM` is an adjacency matrix implementation. It will be developed next and will use the `r CRANpkg("SparseM")` package if it is available. The class `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. # Referencesgraph/vignettes/graphAttributes.Rmd0000644000175200017520000001264514516003535020533 0ustar00biocbuildbiocbuild--- title: "Attributes for Graph Objects" author: - name: "Seth Falcon" - name: "Paul Villafuerte" affiliation: "Vignette translation from Sweave to Rmarkdown / HTML" date: "`r format(Sys.time(), '%B %d, %Y')`" vignette: > %\VignetteIndexEntry{Attributes for Graph Objects} %\VignetteDepends{graph} %\VignetteKeywords{Graph} %\VignettePackage{graph} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} output: BiocStyle::html_document: number_sections: true toc: yes toc_depth: 4 --- # Introduction The `r Biocpkg('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 *graphAM-class* instance, however, any subclass of *graph-class* would work. See FigureĀ [1](#foo){reference-type="ref" reference="foo"}. ```{r exampleGraph1, message=FALSE, results='hide'} 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] ``` ```{r exampleGraph2} (g1 <- graphAM(adjMat=mat)) ``` ```{r foo, fig.cap="The graph `g1`.", fig.height=6, fig.small=TRUE, fig.width=6, echo=FALSE, message=FALSE, out.extra='id="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") } ``` # Edge Attributes ## 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 `edgeDataDefaults` method. A new graph instance will not have any edge attributes defined. ```{r edgeDataDefaults1} edgeDataDefaults(g1) ``` When a new edge attribute is defined, a default value must be specified. Here we will define two edge attributes: `weight` and `code` and specify a default value for each one. ```{r edgeDataDefaults2} 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 `edgeDataDefaults`. ```{r edgeDataDefaults3} edgeDataDefaults(g1, "weight") ``` ## Getting edge attributes Edge attributes are set and accessed using the `edgeData` method. Only attributes defined using `edgeDataDefaults` can be accessed using `edgeData`. If an attribute has not be set using `edgeData` for a given edge, then the default value is used. ```{r 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") ``` ## Setting edge attributes Attributes are set using the replacement form of `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. ```{r 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") ``` We can set the attributes for multiple edges to a single value. ```{r 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") ``` It is also possible to set multiple attributes to different values in a single call to `edgeData`. ```{r edgeData4} 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: ```{r 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") ``` # Node Attributes ## 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 `nodeDataDefaults` method. The interface is similar to `edgeDataDefaults`. ```{r defaultNodeData1} 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. ## Getting and setting node attributes Once a node attribute has been defined and given a default value using `nodeDataDefaults`, individual node attributes can be accessed using `nodeData`. ```{r 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") ``` ```{r other, echo=FALSE} ## We need to reconcile this #g2 <- as(g1, "graphNEL") #edgeWeights(g2) ``` graph/vignettes/references.bib0000644000175200017520000000045214516003535017507 0ustar00biocbuildbiocbuild@Book{Algorithm_4_2_1, title = {Graph Theory and Its Applications}, author = {Gross, J.L. and Yellen, J.}, publisher = {CRC Press, Taylor \& Francis Group}, year = {2005}, edition = {2nd}, isbn = {9781584885054}, series={Textbooks in mathematics}, url = {http://www.crcpress.com}, }