Merge pull request #245 from VEuPathDB/layouts

Layouts

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

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 

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)
 })
 

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
 

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))))

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')

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)