diff --git a/R/class-KPartiteNetwork.R b/R/class-KPartiteNetwork.R index df6b2dd..4a39784 100644 --- a/R/class-KPartiteNetwork.R +++ b/R/class-KPartiteNetwork.R @@ -137,7 +137,7 @@ setMethod("KPartiteNetwork", signature("data.frame", "missing", "missing"), func variables = VariableMetadataList(), ... ) { - new("KPartiteNetwork", links=LinkList(object), nodes=NodeList(object), partitions=partitions, linkColorScheme=linkColorScheme, variableMapping=variables) + new("KPartiteNetwork", links=LinkList(object), nodes=NodeList(object, layout='none'), partitions=partitions, linkColorScheme=linkColorScheme, variableMapping=variables) }) #' @export diff --git a/R/class-Network.R b/R/class-Network.R index 4d3b6a0..3357ff3 100644 --- a/R/class-Network.R +++ b/R/class-Network.R @@ -64,7 +64,10 @@ setClass("Network", #' @param links LinkList #' @param nodes NodeList #' @param object Object containing data to be converted to a Network -#' @param linkColorScheme string defining the type of coloring scheme the links follow. Options are 'none' (default) and 'posneg'. +#' @param linkColorScheme string defining the type of coloring scheme the links follow. +#' Options are 'none' (default) and 'posneg'. +#' @param layout string defining the layout of the network. Options are 'force', 'circle', +#' and 'nicely' which are implemented in igraph. Default is 'nicely'. #' @param variables VariableMetadataList #' @return Network #' @export @@ -100,10 +103,12 @@ setMethod("Network", signature("data.frame", "missing", "missing"), function( links, nodes, linkColorScheme = 'none', + layout = c("nicely", "force", "circle"), variables = VariableMetadataList(), ... ) { - new("Network", links=LinkList(object, linkColorScheme), nodes=NodeList(object), linkColorScheme=linkColorScheme, variableMapping=variables) + layout <- veupathUtils::matchArg(layout) + new("Network", links=LinkList(object, linkColorScheme), nodes=NodeList(object, layout), linkColorScheme=linkColorScheme, variableMapping=variables) }) #' @export diff --git a/R/constructors-Node.R b/R/constructors-Node.R index e996914..f8fe5bc 100644 --- a/R/constructors-Node.R +++ b/R/constructors-Node.R @@ -130,25 +130,44 @@ setMethod("Node", "missing", function(id, x = numeric(), y = numeric(), color = #' #' Generate a NodeList from an edgeList #' @param object Object containing data to be converted to a NodeList +#' @param layout string indicating the layout algorithm to be used. Options are 'none', 'force', +#' 'circle' or 'nicely' which are implemented via igraph. Defaults to 'nicely'. #' @return NodeList #' @export #' @examples #' NodeList(data.frame(source='a',target='b')) -setGeneric("NodeList", function(object) standardGeneric("NodeList")) +setGeneric("NodeList", function(object, ...) standardGeneric("NodeList")) #' @export -setMethod("NodeList", "data.frame", function(object = data.frame(source=character(),target=character())) { +setMethod("NodeList", "data.frame", function(object = data.frame(source=character(),target=character()), layout = c("nicely", "force", "circle", "none")) { if (!inherits(isValidEdgeList(object), "logical")) { stop(paste("Invalid edgeList:", isValidEdgeList(object), collapse = '\n')) } + layout <- veupathUtils::matchArg(layout) - allNodeIds <- c(object$source, object$target) + graph <- igraph::graph_from_data_frame(object, directed = FALSE) + if (layout != "none") { + if (layout == "force") { + coords <- igraph::layout_with_fr(graph) + } else if (layout == "circle") { + coords <- igraph::layout_in_circle(graph) + } else if (layout == "nicely") { + coords <- igraph::layout_nicely(graph) + } else { + stop("layout must be 'force', 'circle' or 'nicely'") + } + rownames(coords) <- names(igraph::V(graph)) + } - makeNodeWithDegree <- function(nodeId, allNodeIds) { - new("Node", id = NodeId(nodeId), degree = length(which(allNodeIds == nodeId))) + # if we want to move this out of the constructor it needs to have graph and coords passed to it + makeNodeWithDegreeAndLayout <- function(nodeId) { + x <- ifelse(layout != "none", coords[nodeId, 1], numeric()) + y <- ifelse(layout != "none", coords[nodeId, 2], numeric()) + degree <- igraph::degree(graph, v = nodeId, mode = "all") + new("Node", id = NodeId(nodeId), degree = unname(degree), x = x, y = y) } - nodesList <- lapply(unique(allNodeIds), makeNodeWithDegree, allNodeIds) + nodesList <- lapply(names(igraph::V(graph)), makeNodeWithDegreeAndLayout) new("NodeList", nodesList) }) diff --git a/R/methods-Network.R b/R/methods-Network.R index ad06098..f5e7fb7 100644 --- a/R/methods-Network.R +++ b/R/methods-Network.R @@ -12,6 +12,7 @@ setMethod("getLinkColorScheme", "Network", function(object) object@linkColorSche # No setters! Once created, a network should only be updated via network methods setMethod("getDegrees", "Network", function(object) getDegrees(getNodes(object))) +setMethod("getCoords", "Network", function(object) getCoords(getNodes(object))) ## General network methods diff --git a/R/methods-Nodes.R b/R/methods-Nodes.R index 7585300..204d45f 100644 --- a/R/methods-Nodes.R +++ b/R/methods-Nodes.R @@ -42,6 +42,14 @@ setMethod("getWeights", "NodeList", function(object) unlist(lapply(as.list(objec setMethod("getColors", "NodeList", function(object) unlist(lapply(as.list(object), color))) setGeneric("getDegrees", function(object) standardGeneric("getDegrees")) setMethod("getDegrees", "NodeList", function(object) unlist(lapply(as.list(object), degree))) +setGeneric("getCoords", function(object) standardGeneric("getCoords")) +setMethod("getCoords", "NodeList", function(object) { + coords <- data.frame(x = unlist(lapply(as.list(object), x)), y = unlist(lapply(as.list(object), y))) + if (nrow(coords) == 0 || all(is.na(coords))) { + return(NULL) + } + return(coords) +}) ## Methods for NodeIdList setMethod("getNodeIds", "NodeIdList", function(object) unlist(lapply(as.list(object), id))) @@ -60,8 +68,8 @@ setMethod(toJSONGeneric, "Node", function(object, named = c(FALSE, TRUE)) { tmp <- character() tmp <- paste0('"id":', jsonlite::toJSON(jsonlite::unbox(id(object)))) - if (!!length(x(object))) tmp <- paste0(tmp, ',"x":', jsonlite::toJSON(jsonlite::unbox(x(object)))) - if (!!length(y(object))) tmp <- paste0(tmp, ',"y":', jsonlite::toJSON(jsonlite::unbox(y(object)))) + if (!!length(x(object)) && !is.na(x(object))) tmp <- paste0(tmp, ',"x":', jsonlite::toJSON(jsonlite::unbox(x(object)))) + if (!!length(y(object)) && !is.na(y(object))) tmp <- paste0(tmp, ',"y":', jsonlite::toJSON(jsonlite::unbox(y(object)))) if (!!length(color(object))) tmp <- paste0(tmp, ',"color":', jsonlite::toJSON(jsonlite::unbox(color(object)))) if (!!length(weight(object))) tmp <- paste0(tmp, ',"weight":', jsonlite::toJSON(jsonlite::unbox(weight(object)))) if (!!length(degree(object)) && !is.na(degree(object))) tmp <- paste0(tmp, ',"degree":', jsonlite::toJSON(jsonlite::unbox(degree(object)))) diff --git a/tests/testthat/test-kpartite-network.R b/tests/testthat/test-kpartite-network.R index 84845da..c07165e 100644 --- a/tests/testthat/test-kpartite-network.R +++ b/tests/testthat/test-kpartite-network.R @@ -166,7 +166,9 @@ test_that("we can build a KPartiteNetwork from an edgeList data.frame", { )) ) - expect_equal(getNodes(net), NodeList(c(Node('a', degree=2), Node('b', degree=2), Node('c', degree=1), Node('d', degree=1)))) + expect_equal(getNodeIds(net), c('a', 'b', 'c', 'd')) + expect_equal(getDegrees(net), c(2, 2, 1, 1)) + expect_equal(getCoords(net), NULL) expect_equal(getLinks(net), LinkList(c(Link(source = Node('a'), target = Node('b')), Link(source = Node('b'), target = Node('a')), Link(source = Node('c'), target = Node('d'))))) expect_equal(partitions(net), Partitions(list(Partition(list(Node('a'), Node('c'))), Partition(list(Node('b'), Node('d')))))) expect_equal(getLinkColorScheme(net), 'none') diff --git a/tests/testthat/test-network.R b/tests/testthat/test-network.R index 78937f6..864d3fe 100644 --- a/tests/testthat/test-network.R +++ b/tests/testthat/test-network.R @@ -183,7 +183,9 @@ test_that("we can build a Network from an edgeList data.frame", { target = c('b', 'c', 'a') ) net <- Network(object = edgeList) - expect_equal(getNodes(net), NodeList(c(Node('a', degree=2), Node('b', degree=2), Node('c', degree=2)))) + expect_equal(getNodeIds(net), c('a', 'b', 'c')) + expect_equal(getDegrees(net), c(2, 2, 2)) + expect_equal(!is.null(getCoords(net)), TRUE) expect_equal(getLinks(net)[[1]]@source, NodeId('a')) expect_equal(getLinks(net)[[1]]@target, NodeId('b')) expect_equal(getLinks(net)[[2]]@source, NodeId('b')) @@ -200,7 +202,9 @@ test_that("we can build a Network from an edgeList data.frame", { weight = c(1,2,3) ) net <- Network(object = edgeList) - expect_equal(getNodes(net), NodeList(c(Node('a', degree=2), Node('b', degree=2), Node('c', degree=2)))) + expect_equal(getNodeIds(net), c('a', 'b', 'c')) + expect_equal(getDegrees(net), c(2, 2, 2)) + expect_equal(!is.null(getCoords(net)), TRUE) expect_equal(getLinks(net)[[2]]@weight, 2) expect_equal(getLinks(net)[[3]]@weight, 3) expect_equal(getLinkColorScheme(net), 'none') @@ -213,7 +217,9 @@ test_that("we can build a Network from an edgeList data.frame", { weight = c(-10,0,10) ) net <- Network(object = edgeList, linkColorScheme = 'posneg') - expect_equal(getNodes(net), NodeList(c(Node('a', degree=2), Node('b', degree=2), Node('c', degree=2)))) + expect_equal(getNodeIds(net), c('a', 'b', 'c')) + expect_equal(getDegrees(net), c(2, 2, 2)) + expect_equal(!is.null(getCoords(net)), TRUE) expect_equal(getLinks(net)[[1]]@weight, -10) expect_equal(getLinks(net)[[2]]@weight, 0) expect_equal(getLinks(net)[[3]]@weight, 10)