hypergraph/DESCRIPTION0000644000175100017510000000146414614340450015457 0ustar00biocbuildbiocbuildPackage: hypergraph Title: A package providing hypergraph data structures Version: 1.76.0 Author: Seth Falcon, Robert Gentleman Description: A package that implements some simple capabilities for representing and manipulating hypergraphs. Maintainer: Bioconductor Package Maintainer License: Artistic-2.0 Depends: R (>= 2.1.0), methods, utils, graph Suggests: BiocGenerics, RUnit LazyLoad: yes Collate: AllClasses.R AllGenerics.R kCores.R methods-Hyperedge.R methods-Hypergraph.R biocViews: GraphAndNetwork git_url: https://git.bioconductor.org/packages/hypergraph git_branch: RELEASE_3_19 git_last_commit: 2762e9b git_last_commit_date: 2024-04-30 Repository: Bioconductor 3.19 Date/Publication: 2024-04-30 NeedsCompilation: no Packaged: 2024-05-01 04:12:24 UTC; biocbuild hypergraph/inst/0000755000175100017510000000000014614230766014731 5ustar00biocbuildbiocbuildhypergraph/inst/unitTests/0000755000175100017510000000000014614230766016733 5ustar00biocbuildbiocbuildhypergraph/inst/unitTests/test_hyperedge.R0000644000175100017510000000227514614230766022077 0ustar00biocbuildbiocbuildtestHyperedge <- function() { nodes <- LETTERS[1:4] label <- "Simple hyperedge" he <- new("Hyperedge", nodes=nodes, label=label) checkEquals(nodes, nodes(he)) checkEquals(label, label(he)) ## change label label(he) <- "newone" checkEquals("newone", label(he)) ## check that we can omit the label he2 <- new("Hyperedge", nodes=nodes) checkEquals(nodes, nodes(he2)) checkEquals(TRUE, is.na(label(he2))) } testDirectedHyperedge <- function() { head <- LETTERS[1:4] tail <- LETTERS[19:21] label <- "Directed hyperedge" dhe <- new("DirectedHyperedge", head=head, tail=tail, label=label) checkEquals(head, head(dhe)) checkEquals(tail, tail(dhe)) checkEquals(TRUE, setequal(c(tail, head), nodes(dhe))) checkEquals(TRUE, is(dhe, "Hyperedge")) } testToUndirected <- function() { head <- LETTERS[1:4] tail <- LETTERS[19:21] label <- "Directed hyperedge" ## omit the label dhe <- new("DirectedHyperedge", head=head, tail=tail) he <- toUndirected(dhe) checkEquals(TRUE, setequal(nodes(dhe), nodes(he))) checkEquals(TRUE, is(he, "Hyperedge")) checkEquals(FALSE, is(he, "DirectedHyperedge")) } hypergraph/inst/unitTests/test_hypergraph.R0000644000175100017510000001006714614230766022272 0ustar00biocbuildbiocbuildsimpleHypergraph <- function() { nodes <- LETTERS[1:4] hEdges <- lapply(list("A", LETTERS[1:2], LETTERS[3:4]), "Hyperedge") hg <- new("Hypergraph", nodes=nodes, hyperedges=hEdges) } testConstruction <- function() { hg <- simpleHypergraph() checkEquals(TRUE, is(hg, "Hypergraph")) } testDirectedHypergraph <- function() { nodes <- letters[1:4] dhe1 <- DirectedHyperedge(tail=c("a", "b"), head=c("c", "d")) dhe2 <- DirectedHyperedge(tail=c("a"), head=c("b", "c", "d")) dhe3 <- DirectedHyperedge(tail=c("b", "c"), head=c("d")) dhe4 <- DirectedHyperedge(tail=c("a"), head=c("b")) hg <- new("Hypergraph", nodes=nodes, hyperedges=list(dhe1, dhe2, dhe3, dhe4)) checkEquals(TRUE, is(hg, "Hypergraph")) } testHyperedges <- function() { nodes <- LETTERS[1:4] eList <- list("A", LETTERS[1:2], LETTERS[3:4]) hEdges <- l2hel(eList) hg <- new("Hypergraph", nodes=nodes, hyperedges=hEdges) ## Add "default" labels for (i in seq_along(hEdges)) { he <- hEdges[[i]] label(he) <- as.character(i) hEdges[[i]] <- he } checkEquals(hEdges, hyperedges(hg)) checkEquals(as.character(seq_along(eList)), hyperedgeLabels(hg)) } testHyperedgeLabels <- function() { hg <- simpleHypergraph() expect <- as.character(1:3) checkEquals(expect, hyperedgeLabels(hg)) } testNodes <- function() { nodes <- LETTERS[1:4] hEdges <- lapply(c("A", LETTERS[1:2], LETTERS[3:4]), "Hyperedge") hg <- new("Hypergraph", nodes=nodes, hyperedges=hEdges) checkEquals(nodes, nodes(hg)) } testBadHyperedges <- function() { nodes <- LETTERS[1:4] hyperedges <- list(matrix(0, nrow=2, ncol=2)) checkException(new("Hypergraph", nodes=nodes, hyperedges=hyperedges)) hyperedges <- lapply(list(1:2, 1:3), "Hyperedge") checkException(new("Hypergraph", nodes=nodes, hyperedges=hyperedges)) hyperedges <- lapply(list("A", c("A", "B"), c("C", "Z"), c("Q", "R", "S")), "Hyperedge") checkException(new("Hypergraph", nodes=nodes, hyperedges=hyperedges)) } testNumNodes <- function() { nodes <- letters[1:10] hyperedges <- list(Hyperedge("a")) hg <- new("Hypergraph", nodes=nodes, hyperedges=hyperedges) checkEquals(10, numNodes(hg)) } testInciMat <- function() { nodes <- letters[1:4] hEdges <- lapply(list(c("a", "b"), c("b", "c"), c("c", "d", "a")), "Hyperedge") hg <- new("Hypergraph", nodes=nodes, hyperedges=hEdges) mat <- inciMat(hg) expected <- cbind(c(1, 1, 0, 0), c(0, 1, 1, 0), c(1, 0, 1, 1)) rownames(expected) <- nodes colnames(expected) <- as.character(1:length(hEdges)) checkEquals(expected, mat) checkEquals(dimnames(expected), dimnames(mat)) } testToGraphNEL <- function() { hg <- simpleHypergraph() bpg <- toGraphNEL(hg) checkEquals(TRUE, is(bpg, "graphNEL")) checkEquals(7, length(nodes(bpg))) checkEquals(5, numEdges(bpg)) expectEdges <- list(A=c("1", "2"), B="2", C="3", D="3", "1"="A", "2"=c("A", "B"), "3"=c("C", "D")) bpEdges <- edges(bpg) checkEquals(expectEdges, bpEdges) expectNodes <- c(LETTERS[1:4], 1:3) checkEquals(expectNodes, nodes(bpg)) } ## testToGraphAM <- function() { ## hg <- simpleHypergraph() ## bpg <- toGraphAM(hg) ## checkEquals(TRUE, is(bpg, "graphAM")) ## checkEquals(7, length(nodes(bpg))) ## checkEquals(5, numEdges(bpg)) ## expectEdges <- list(A=c("1", "2"), ## B="2", ## C="3", ## D="3", ## "1"="A", ## "2"=c("A", "B"), ## "3"=c("C", "D")) ## bpEdges <- edges(bpg) ## checkEquals(expectEdges, bpEdges) ## expectNodes <- c(LETTERS[1:4], 1:3) ## checkEquals(expectNodes, nodes(bpg)) ## } hypergraph/man/0000755000175100017510000000000014614230766014527 5ustar00biocbuildbiocbuildhypergraph/man/DirectedHyperedge-class.Rd0000644000175100017510000000445214614230766021506 0ustar00biocbuildbiocbuild\name{DirectedHyperedge-class} \docType{class} \alias{DirectedHyperedge-class} \alias{initialize,DirectedHyperedge-method} \alias{nodes,DirectedHyperedge-method} \alias{show,DirectedHyperedge-method} \alias{head} \alias{head,DirectedHyperedge-method} \alias{tail} \alias{tail,DirectedHyperedge-method} \alias{toUndirected} \alias{toUndirected,DirectedHyperedge-method} \title{Class DirectedHyperedge} \description{This class represents directed hyperedges in a \code{\link{Hypergraph-class}}. A directed hyperedge consists of two disjount sets of nodes, those in the tail and those in the head of the hyperedge. Directed hyperedges are sometimes called hyperarcs. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("DirectedHyperedge", head, tail, label)}. You can also use the convenience function \code{\link{DirectedHyperedge}}. } \section{Slots}{ \describe{ \item{\code{tail}:}{Character vector of nodes in the tail of the hyperedge} \item{\code{head}:}{Character vector of nodes in the head of the hyperege} \item{\code{label}:}{Character string describing the directed hyperedge} } } \section{Extends}{ Class \code{"Hyperedge"}, directly. } \section{Methods}{ \describe{ \item{head}{\code{signature(x = "DirectedHyperedge")}: Return a vector containing the nodes in the head of the hyperedge} \item{tail}{\code{signature(x = "DirectedHyperedge")}: Return a vector containing the nodes in the tail of the hyperedge} \item{initialize}{\code{signature(.Object = "DirectedHyperedge")}: Create a new instance.} \item{nodes}{\code{signature(object = "DirectedHyperedge")}: Return a vector containing all nodes present in the hyperedge.} \item{show}{\code{signature(object = "DirectedHyperedge")}: Print me } \item{toUndirected}{\code{signature(.Object = "DirectedHyperedge")}: Return a \code{\link{Hyperedge-class}} object that results from coercing to an undirected hyperedge.} } } \author{Seth Falcon} \seealso{ \code{\link{DirectedHyperedge}} \code{\link{Hyperedge}} \code{\link{Hyperedge-class}} \code{\link{Hypergraph-class}} } \examples{ head <- LETTERS[1:4] tail <- LETTERS[19:21] label <- "Directed hyperedge" dhe <- new("DirectedHyperedge", head=head, tail=tail, label=label) } \keyword{classes} hypergraph/man/DirectedHyperedge.Rd0000644000175100017510000000142014614230766020373 0ustar00biocbuildbiocbuild\name{DirectedHyperedge} \alias{DirectedHyperedge} \title{Constructor for DirectedHyperedge objects} \description{ A convenience constructor for \code{\link{DirectedHyperedge-class}} objects } \usage{ DirectedHyperedge(head, tail, label = "") } %- maybe also 'usage' for other objects documented here. \arguments{ \item{head}{Character vector of nodes that are part of the head of the hyperedge} \item{tail}{Character vector of nodes that part of the tail of the hyperedge} \item{label}{A character string describing the directed hyperedge} } \value{ An object of class \code{\link{DirectedHyperedge-class}} } \author{Seth Falcon} \seealso{ \code{\link{DirectedHyperedge-class}} \code{\link{Hyperedge-class}} \code{\link{Hypergraph-class}} } \keyword{classes} hypergraph/man/Hyperedge-class.Rd0000644000175100017510000000342514614230766020041 0ustar00biocbuildbiocbuild\name{Hyperedge-class} \docType{class} \alias{Hyperedge-class} \alias{initialize,Hyperedge-method} \alias{label} \alias{label,Hyperedge-method} \alias{label<-} \alias{label<-,Hyperedge,character-method} \alias{nodes,Hyperedge-method} \alias{show,Hyperedge-method} \title{Class Hyperedge} \description{A Hyperedge object represents a hyperedge in a hypergraph, that is, a subset of the nodes of a hypergraph. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("Hyperedge", nodes, label)}. You can also use the convenience function \code{Hyperedge} to create instances. This is especially useful for creating a list of \code{Hyperedge} instances using \code{\link{lapply}}. } \section{Slots}{ \describe{ \item{\code{head}:}{A vector of mode \code{"character"} containing the node labels that are a part of the hyperedge} \item{\code{label}:}{An arbitrary \code{"character"} string describing this hyperedge } } } \section{Methods}{ \describe{ \item{initialize}{\code{signature(.Object = "Hyperedge")}: Create an instance} \item{label}{\code{signature(object = "Hyperedge")}: Return the value of the \code{label} slot } \item{label<-}{\code{signature(object = "Hyperedge", value = "character")}: Set the label slot.} \item{nodes}{\code{signature(object = "Hyperedge")}: Return a vector containing the nodes in the hyperedge } \item{show}{\code{signature(object = "Hyperedge")}: Print a textual summary of the hyperedge } } } \author{Seth Falcon} \seealso{ \code{\link{Hyperedge}} \code{\link{Hypergraph-class}} \code{\link{DirectedHyperedge-class}} } \examples{ nodes <- LETTERS[1:4] label <- "Simple hyperedge" ## Use the convenience constructor he <- Hyperedge(nodes, label) } \keyword{classes} hypergraph/man/Hyperedge.Rd0000644000175100017510000000110614614230766016730 0ustar00biocbuildbiocbuild\name{Hyperedge} \alias{Hyperedge} \title{Constructor for Hyeredge objects} \description{ A convenience constructor for \code{\link{Hyperedge-class}} objects } \usage{ Hyperedge(nodes, label = "") } %- maybe also 'usage' for other objects documented here. \arguments{ \item{nodes}{Character vector of nodes that are part of the hyperedge} \item{label}{A character string describing the hyperedge} } \value{ An object of class \code{\link{Hyperedge-class}} } \author{Seth Falcon} \seealso{ \code{\link{Hyperedge-class}} \code{\link{Hypergraph-class}} } \keyword{classes} hypergraph/man/Hypergraph-class.Rd0000644000175100017510000000522214614230766020233 0ustar00biocbuildbiocbuild\name{Hypergraph-class} \docType{class} \alias{Hypergraph-class} \alias{hyperedges,Hypergraph-method} \alias{inciMat} \alias{inciMat,Hypergraph-method} \alias{inciMat2HG} \alias{inciMat2HG,matrix-method} \alias{initialize,Hypergraph-method} \alias{nodes,Hypergraph-method} \alias{numNodes,Hypergraph-method} \alias{toGraphNEL} \alias{toGraphNEL,Hypergraph-method} \alias{hyperedges} \alias{hyperedges,Hypergraph-method} \alias{hyperedgeLabels} \alias{hyperedgeLabels,Hypergraph-method} \title{Class Hypergraph} \description{A hypergraph consists of a set of nodes and a set of hyperedges. Each hyperedge is a subset of the node set. This class provides a representation of a hypergraph that is (hopefully) useful for computing. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("Hypergraph", nodes, hyperedges)}. You can also use the convenience function \code{Hypergraph}. The \code{nodes} argument should be a character vector of distinct labels representing the nodes of the hypergraph. The \code{hyperedges} argument must be a list of \code{\link{Hyperedge-class}} objects. } \section{Slots}{ \describe{ \item{\code{nodes}:}{A \code{"character"} vector specifying the nodes} \item{\code{hyperedges}:}{A \code{"list"} of \code{\link{Hyperedge-class}} objects} } } \section{Methods}{ \describe{ \item{hyperedges}{\code{signature(.Object = "Hypergraph")}: Return the list of \code{Hyperedge} objects } \item{hyperedgeLabels}{\code{signature(.Object = "Hypergraph")}: Return a character vector of labels for the \code{Hyperedge} objects in the hypergraph.} \item{inciMat}{\code{signature(.Object = "Hypergraph")}: Return the incidence matrix representation of this hypergraph } \item{inciMat2HG}{\code{signature(.Object = "matrix")}: Return the hypergraph representation of this incidence matrix } \item{initialize}{\code{signature(.Object = "Hypergraph")}: Create an instance} \item{nodes}{\code{signature(object = "Hypergraph")}: Return the vector of nodes (character vector) } \item{numNodes}{\code{signature(object = "Hypergraph")}: Return the number of nodes in the hypergraph } \item{toGraphNEL}{\code{signature(.Object = "Hypergraph")}: Return the \code{graphNEL} representation of the hypergraph (a bipartite graph) } } } \author{Seth Falcon} \seealso{ \code{\link{Hyperedge-class}} \code{\link{DirectedHyperedge-class}} \code{\link[graph]{graphNEL-class}} } \examples{ nodes <- LETTERS[1:4] hEdges <- lapply(list("A", LETTERS[1:2], LETTERS[3:4]), "Hyperedge") hg <- new("Hypergraph", nodes=nodes, hyperedges=hEdges) } \keyword{classes} hypergraph/man/Hypergraph.Rd0000644000175100017510000000105314614230766017126 0ustar00biocbuildbiocbuild\name{Hypergraph} \alias{Hypergraph} \title{Constructor for Hypergraph objects} \description{ A convenience constructor for \code{link{Hypergraph-class}} objects } \usage{ Hypergraph(nodes, hyperedges) } \arguments{ \item{nodes}{A vector of nodes (character)} \item{hyperedges}{A list of \code{\link{Hyperedge-class}} objects} } \value{ An object of class \code{\link{Hypergraph-class}} } \author{Seth Falcon} \seealso{ \code{\link{Hypergraph-class}} \code{\link{Hyperedge-class}} \code{\link{DirectedHyperedge-class}} } \keyword{classes} hypergraph/man/kCores.Rd0000644000175100017510000000312014614230766016240 0ustar00biocbuildbiocbuild\name{kCoresHypergraph} \alias{kCoresHypergraph} \title{Find all the k-cores in a hypergraph} \description{Find all the k-cores in a hypergraph } \usage{ kCoresHypergraph(hg) } \arguments{ \item{hg}{an instance of the \code{Hypergraph} class } } \details{ A k-core in a hypergraph is a maximal subhypergraph where (a) no hyperedge is contained in another, and (b) each node is adjacent to at least \code{k} hyperedges in the subgraph. The implementation is based on the algorithm by E. Ramadan, A. Tarafdar, A. Pothen, 2004. } \value{ A vector of the core numbers for all the nodes in \code{g}. } \references{ A hypergraph model for the yeast protein complex network, Ramadan, E. Tarafdar, A. Pothen, A., Parallel and Distributed Processing Symposium, 2004. Proceedings. 18th International. } \author{Li Long } \examples{ # to turn the snacoreex.gxl (from RBGL package) graph to a hypergraph # this is a rough example kc_hg_n <- c("A", "C", "B", "E", "F", "D", "G", "H", "J", "K", "I", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U") kc_hg_e <- list(c("A", "C"), c("B", "C"), c("C", "E"), c("C", "F"), c("E", "D"), c("E", "F"), c("D", "G"), c("D", "H"), c("D", "J"), c("H", "G"), c("H", "J"), c("G", "J"), c("J", "M"), c("J", "K"), c("M", "K"), c("M", "O"), c("M", "N"), c("K", "N"), c("K", "F"), c("K", "I"), c("K", "L"), c("F", "I"), c("I", "L"), c("F", "L"), c("P", "Q"), c("Q", "R"), c("Q", "S"), c("R", "T"), c("S", "T")) kc_hg_he <- lapply(kc_hg_e, "Hyperedge") kc_hg <- new("Hypergraph", nodes=kc_hg_n, hyperedges=kc_hg_he) kCoresHypergraph(kc_hg) } \keyword{ models } hypergraph/man/l2hel.Rd0000644000175100017510000000160514614230766016026 0ustar00biocbuildbiocbuild\name{l2hel} \alias{l2hel} \title{Create lists of Hyperedge objects} \description{ Conveniently create lists of \code{\link{Hyperedge-class}} instances. } \usage{ l2hel(e) } \arguments{ \item{e}{A list of character vectors. Each element of the list represents a hyperedge and the character vector value specifies the nodes of the hypergraph that are part of the hyperedge. The names of the list elements, if found, will be used as the label for the corresponding Hyperedge object.} } \value{ A list of \code{Hyperedge-class} objects. If the list \code{e} did not have names, the labels of the Hyperedges will be set to its index in the list coerced to character. } \author{Seth Falcon} \seealso{ \code{\link{Hyperedge-class}} \code{\link{Hypergraph-class}} } \examples{ edges <- list("e1"="A", "e2"=c("A", "B"), "e3"=c("C", "D")) hEdgeList <- l2hel(edges) } \keyword{classes} hypergraph/man/vCover.Rd0000644000175100017510000000345114614230766016265 0ustar00biocbuildbiocbuild\name{vCoverHypergraph} \alias{vCoverHypergraph} \title{Approximate minimum weight vertex cover in a hypergraph} \description{Approximate minimum weight vertex cover in a hypergraph } \usage{ vCoverHypergraph(hg, vW=rep(1, numNodes(hg))) } \arguments{ \item{hg}{an instance of the \code{Hypergraph} class } \item{vW}{vertex weights} } \details{ Hypergraph \code{g} has non-negative weights on its vertices. The minimum weight vertex cover problem is to find a subset of vertices C such that C includes at least one vertex from each hyperedge and the sum of the weights of the vertices in C is minimum. This problem is NP-hard. We implement the greedy algorithm to approximate near-optimal solution, proposed by E. Ramadan, A. Tarafdar, A. Pothen, 2004. } \value{ A list of vertices from hypergraph \code{g}. } \references{ A hypergraph model for the yeast protein complex network, Ramadan, E. Tarafdar, A. Pothen, A., Parallel and Distributed Processing Symposium, 2004. Proceedings. 18th International. } \author{Li Long } \examples{ # to turn the snacoreex.gxl graph (from RBGL package) to a hypergraph # this is a rough example kc_hg_n <- c("A", "C", "B", "E", "F", "D", "G", "H", "J", "K", "I", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U") kc_hg_e <- list(c("A", "C"), c("B", "C"), c("C", "E"), c("C", "F"), c("E", "D"), c("E", "F"), c("D", "G"), c("D", "H"), c("D", "J"), c("H", "G"), c("H", "J"), c("G", "J"), c("J", "M"), c("J", "K"), c("M", "K"), c("M", "O"), c("M", "N"), c("K", "N"), c("K", "F"), c("K", "I"), c("K", "L"), c("F", "I"), c("I", "L"), c("F", "L"), c("P", "Q"), c("Q", "R"), c("Q", "S"), c("R", "T"), c("S", "T")) kc_hg_he <- lapply(kc_hg_e, "Hyperedge") kc_hg <- new("Hypergraph", nodes=kc_hg_n, hyperedges=kc_hg_he) vCoverHypergraph(kc_hg) } \keyword{ models } hypergraph/NAMESPACE0000644000175100017510000000070614614230766015176 0ustar00biocbuildbiocbuildimport(methods) importFrom(utils, head, tail) import(graph) exportClasses(Hypergraph, Hyperedge, DirectedHyperedge) exportMethods( nodes, label, "label<-", show, toUndirected, head, tail, hyperedges, numNodes, inciMat, inciMat2HG, initialize, toGraphNEL, hyperedgeLabels ) export( kCoresHypergraph, vCoverHypergraph ) export( Hypergraph, Hyperedge, DirectedHyperedge, l2hel ) hypergraph/R/0000755000175100017510000000000014614230766014155 5ustar00biocbuildbiocbuildhypergraph/R/AllClasses.R0000644000175100017510000000037414614230766016332 0ustar00biocbuildbiocbuildsetClass("Hyperedge", representation(head="character", label="character")) setClass("DirectedHyperedge", representation(tail="character"), contains="Hyperedge") setClass("Hypergraph", representation(nodes="character", hyperedges="list")) hypergraph/R/AllGenerics.R0000644000175100017510000000132214614230766016466 0ustar00biocbuildbiocbuild## FIXME: Is there a way to ask for the generic from package graph? That's ## the one we want, if defined. setGeneric("label", function(object) standardGeneric("label")) setGeneric("label<-", function(object, value) standardGeneric("label<-")) setGeneric("toUndirected", function(.Object) standardGeneric("toUndirected")) setGeneric("hyperedges", function(.Object) standardGeneric("hyperedges")) setGeneric("hyperedgeLabels", function(.Object) standardGeneric("hyperedgeLabels")) setGeneric("inciMat", function(.Object) standardGeneric("inciMat")) setGeneric("inciMat2HG", function(.Object) standardGeneric("inciMat2HG")) setGeneric("toGraphNEL", function(.Object) standardGeneric("toGraphNEL")) hypergraph/R/kCores.R0000644000175100017510000000703714614230766015535 0ustar00biocbuildbiocbuild# # Reference: # A hypergraph model for the yeast protein complex network # By E. Ramadan, A. Tarafdar, A. Pothen # Procs. Workshop High Performance Computational Biology, IEEE/ACM 2004 # # algorithm for computing the k-core of a hypergraph: # =================================================== # # while there are vertices with degree < k do # { # for each such vertex v do # { # for each hyperedge f associated with v do # { # delet v from adj(f) # decrement d(f) by 1 # if f is non-maximal then # { # for each vertex w associated with f do # { # delete f from adj(w) # decrement d(w) by 1 # if ( d(w) < k then # { # include w in list of vertices with degree < k # } # } # } # } # } # } # kCoresHypergraph <- function(hg) { nv <- numNodes(hg) core <- array(0, nv, dimnames = list(nodes(hg))) im <- inciMat(hg) ne <- ncol(im) v_deg <- sort(rowSums(im)) k_num <- 0 for ( i in 1:nv ) { v <- names(v_deg)[i] k_num <- max(v_deg[v], k_num) core[v] <- k_num # v's hyperedges he_set <- which(im[v,] == 1) im[v, he_set] <- 0 # remove non-maximal hyperedges # (1) selective approach for ( f in names(he_set) ) { # hyperedges adjacent to f r_chosen <- which(im[, f] == 1) c_chosen <- which(im[r_chosen, ] > 0) im_sub <- matrix(im[r_chosen, c_chosen], nrow=length(r_chosen), ncol=length(c_chosen)) rownames(im_sub) <- names(r_chosen) colnames(im_sub) <- names(c_chosen) for ( g in names(c_chosen) ) if ( f != g && im_sub[, f] == im_sub[, g] ) { im[, f] <- 0 } } v_deg <- sort(rowSums(im)) ## # (2) brute-force approach ## for ( f in he_set ) ## { ## for ( g in 1:ne ) ## if ( f != g && sum(im[, f] & im[, g]) == sum(im[, f]) ) ## { ## im[, f] <- 0 ## } ## } ## v_deg <- sort(rowSums(im)) } core } # # greedy algorithm for computing an approximate minimum weight vertex # cover of a hypergraph # =================================================================== # # F[i] is the set of hy[eredges not yet covered by a partial vertex cover # at the begining of the i-th iteration # # cost function alpha(v) = w(v) / | adj(v) intersect F[i] | # which distributes the weight of the vertex equally among the hyperedges # it belongs to that are currently uncovered. # # at each step, it chooses a vertex with minimum cost alpha(v) to include # in the partial cover, deletes all hyperedges it covers # # initialize: # i = 1; // iteration number # C = 0; // cover # F[1] = F; # // hyperedges yet to be covered # while F[i] != 0 do # { # for ( v in V - C ) do # { # choose a vectex v[i] with min cost alpha(v); # add v[i] to the cover C; # F[i+1] = F[i] - adj(v[i]); # i = i+1; # } # } # vCoverHypergraph <- function(hg, vW=rep(1, numNodes(hg))) { V <- nodes(hg) im <- inciMat(hg) names(vW) <- V deg <- rowSums(im) C <- names(which(deg == 0)) F <- setdiff(V, C) while ( length(F) > 1 ) { # choose a vectex v[i] with min cost alpha(v) deg <- rowSums(im) vW_cur <- vW / deg v <- names(which.min(vW_cur)) C <- c(C, v) adj_he <- names(which(im[v,] == 1)) im[v, ] <- 0 im[, adj_he] <- 0 r_chosen <- names(which(rowSums(im) > 0)) c_chosen <- names(which(colSums(im) > 0)) im <- im[r_chosen, c_chosen, drop = FALSE] vW <- vW[r_chosen] F <- r_chosen } C } hypergraph/R/methods-Hyperedge.R0000644000175100017510000000504414614230766017660 0ustar00biocbuildbiocbuild## Hyperedge methods setMethod("initialize", "Hyperedge", function(.Object, nodes, label) { .Object@head <- as.character(nodes) if (missing(label)) { label <- "" label[1] <- NA ## want an NA of type character } .Object@label <- label .Object }) Hyperedge <- function(nodes, label="") new("Hyperedge", nodes=nodes, label=label) l2hel <- function(e) { ## Convenience function to create lists of Hyperedges numEdges <- length(e) hel <- vector(mode="list", length=numEdges) nms <- names(e) if (is.null(nms)) nms <- as.character(1:numEdges) for (i in 1:numEdges) hel[[i]] <- Hyperedge(nodes=e[[i]], label=nms[i]) hel } setMethod("nodes", signature(object="Hyperedge"), function(object) object@head) setMethod("label", signature(object="Hyperedge"), function(object) object@label) setReplaceMethod("label", signature(object="Hyperedge", value="character"), function(object, value) { if (length(value) != 1) stop("Labels for Hyperedges must be character vectors of length 1") object@label <- value object }) setMethod("show", signature(object="Hyperedge"), function(object) { cat(paste("A", class(object)[1]), "containing", length(nodes(object)), "nodes.\n") }) ## DirectedHyperedge methods setMethod("initialize", "DirectedHyperedge", function(.Object, head, tail, label="") { .Object@label <- label .Object@head <- as.character(head) .Object@tail <- as.character(tail) .Object }) DirectedHyperedge <- function(head, tail, label="") new("DirectedHyperedge", head=head, tail=tail, label=label) setMethod("nodes", signature(object="DirectedHyperedge"), function(object) { c(object@tail, object@head) }) setMethod("toUndirected", signature(.Object="DirectedHyperedge"), function(.Object) { new("Hyperedge", nodes=nodes(.Object), label=label(.Object)) }) setMethod("head", signature(x="DirectedHyperedge"), function(x) x@head) setMethod("tail", signature(x="DirectedHyperedge"), function(x) x@tail) setMethod("show", "DirectedHyperedge", function(object) { callNextMethod() cat(length(tail(object)), "nodes in the tail and ") cat(length(head(object)), "nodes in head.\n") }) hypergraph/R/methods-Hypergraph.R0000644000175100017510000001033714614230766020056 0ustar00biocbuildbiocbuildsetMethod("initialize", "Hypergraph", function(.Object, nodes=character(), hyperedges=list()) { ## Create a new hypergraph instance. ## ## nodes: character vector of node names ## ## hyperedges: a list of character vectors describing subsets of the nodes. ## .Object@nodes = nodes hypergraph:::checkValidHyperedges(hyperedges, nodes) hyperedges <- addDefaultHyperedgeLabels(hyperedges) .Object@hyperedges = hyperedges .Object }) Hypergraph <- function(nodes, hyperedges) { ## Convenience function to create Hypergraph instances new("Hypergraph", nodes=nodes, hyperedges=hyperedges) } checkValidHyperedges <- function(hyperedges, nnodes) { goodHyperedges <- unlist(lapply(hyperedges, is, "Hyperedge")) if (!all(goodHyperedges)) stop("hyperedge list elements must be instances of the Hyperedge class.") hyperedgeSet <- unlist(lapply(hyperedges, nodes)) unknownNodes <- !(hyperedgeSet %in% nnodes) if (any(unknownNodes)) { unknownNodes <- hyperedgeSet[unknownNodes] msg <- paste("The hyperedge list is not valid because it", "specifies nodes not in the node vector:") msg <- paste(msg, paste(dQuote(unknownNodes), collapse=" "), sep="\n") stop(msg) } TRUE } addDefaultHyperedgeLabels <- function(hyperedges) { for (i in seq_len(length(hyperedges))) { hEdge <- hyperedges[[i]] lab <- label(hEdge) if (is.null(lab) || length(lab) < 1 || lab == "") { lab <- as.character(i) label(hEdge) <- lab hyperedges[[i]] <- hEdge } } hyperedges } setMethod("hyperedges", signature(.Object="Hypergraph"), function(.Object) .Object@hyperedges) setMethod("hyperedgeLabels", signature(.Object="Hypergraph"), function(.Object) sapply(.Object@hyperedges, label)) setMethod(graph::nodes, signature(object="Hypergraph"), function(object) object@nodes) setMethod(graph::numNodes, signature(object="Hypergraph"), function(object) length(object@nodes)) setMethod("inciMat", signature(.Object="Hypergraph"), function(.Object) { nds <- nodes(.Object) hEdgeList <- hyperedges(.Object) createInciMat(nds, hEdgeList) }) setMethod("inciMat2HG", signature(.Object="matrix"), function(.Object){ rn <- rownames(.Object) hgList <- apply(.Object, 2, function(x){ names(which(x == 1)) }) heList <- l2hel(hgList) hg <- Hypergraph(rn, heList) hg }) createInciMat <- function(nodes, edgeList) { inciMat <- matrix(0, nrow=length(nodes), ncol=length(edgeList)) for (j in 1:length(edgeList)) { col <- as.numeric(nodes %in% nodes(edgeList[[j]])) inciMat[, j] <- col } rownames(inciMat) <- nodes colnames(inciMat) <- sapply(edgeList, label) inciMat } setMethod("toGraphNEL", signature(.Object="Hypergraph"), function(.Object) { hEdges <- hyperedges(.Object) hEdgeNames <- names(hEdges) if (is.null(hEdgeNames)) hEdgeNames <- as.character(1:length(hEdges)) if (any(hEdgeNames %in% nodes(.Object))) stop("hyperedge names must be distinct from node names") bpgNodes <- c(nodes(.Object), hEdgeNames) heEdgeL <- lapply(hEdges, function(x) { list(edges=match(nodes(x), bpgNodes), weights=rep(1, length(nodes(x))))}) names(heEdgeL) <- hEdgeNames hnEdgeL <- vector(mode="list", length=length(nodes(.Object))) names(hnEdgeL) <- nodes(.Object) for (i in 1:length(hEdges)) { he <- hEdges[[i]] heNode <- hEdgeNames[i] heNodeIndex <- which(heNode == bpgNodes) for (n in nodes(he)) hnEdgeL[[n]] <- append(hnEdgeL[[n]], heNodeIndex) } hnEdgeL <- lapply(hnEdgeL, function(x) { list(edges=x, weights=rep(1, length(x)))}) bpgEdgeL <- c(heEdgeL, hnEdgeL) new("graphNEL", bpgNodes, bpgEdgeL) }) hypergraph/tests/0000755000175100017510000000000014614230766015116 5ustar00biocbuildbiocbuildhypergraph/tests/hypergraph_unit_tests.R0000644000175100017510000000005114614230766021667 0ustar00biocbuildbiocbuildBiocGenerics:::testPackage("hypergraph")