get tests passing again

R/class-KPartiteNetwork.R

@@ -1,10 +1,10 @@
-  isLinkWithinPartition <- function(link) {
-    if (is.null(link)) {
-      return(FALSE)
-    }
+  isLinkWithinPartition <- function(link, partitions) {
     if (!inherits(link, "Link")) {
       stop('link must be a Link object')
     }
+    if (!inherits(partitions, "Partitions")) {
+      stop('partitions must be a Partitions object')
+    }
 
     source <- source(link)
     target <- target(link)
@@ -14,7 +14,7 @@
     }
 
     internalLink <- FALSE
-    if (getPartitionIndex(source) == getPartitionIndex(target)) {
+    if (getPartitionIndex(partitions, source) == getPartitionIndex(partitions, target)) {
       internalLink <- TRUE
     }
 
@@ -29,15 +29,16 @@ check_kpartite_network <- function(object) {
   # Check that all nodes are in at least one of the partitions
   if (!all(getNodeIds(object@nodes) %in% getAllNodeIds(object@partitions))) {
     errors <- c(errors, 'Found a node that is not in any partition. All nodes must be assigned to a partition.')
+  } else if (any(sapply(getLinks(object), isLinkWithinPartition, object@partitions))) {
+    # Check that there are no links connecting nodes within a partition, only across the different partitions
+    # this check wont work if a node is missing from a partition
+    errors <- c(errors, 'Found a link between nodes in the same partition. Links between nodes in the same partition are not allowed.')
   }
   if (!all(getAllNodeIds(object@partitions) %in% getNodeIds(object@nodes))) {
     errors <- c(errors, 'Found an node id in a partition that is not in the nodes list. Node IDs must be consistent between partitions and nodes slots.')
   }
 
-  # Check that there are no links connecting nodes within a partition, only across the different partitions
-  if (any(sapply(getLinks(object), isLinkWithinPartition))) {
-    errors <- c(errors, 'Found a link between nodes in the same partition. Links between nodes in the same partition are not allowed.')
-  }
+
 
 
   # Check that linkColorScheme is one of the accepted values

R/class-Link.R

@@ -141,6 +141,8 @@ setGeneric("LinkList", function(object, linkColorScheme = c('none', 'posneg')) s
 
 #' @export
 setMethod("LinkList", "data.frame", function(object = data.frame(source=character(),target=character()), linkColorScheme = c('none', 'posneg')) {
+  linkColorScheme <- veupathUtils::matchArg(linkColorScheme)
+
   if (!inherits(isValidEdgeList(object), "logical")) {
     stop(paste("Invalid edgeList:", isValidEdgeList(object), collapse = '\n'))
   }

R/class-Partitions.R

@@ -70,9 +70,15 @@ Partitions <- function(partitions = list()) {
 #' Given a list of partitions and a node id, return the index
 #' of the partition that the node belongs to.
 #' @param partitions Partitions
-#' @param nodeId NodeId
+#' @param node character, NodeId or Node object
 #' @export
-setGeneric("getPartitionIndex", function(partitions, nodeId) standardGeneric("getPartitionIndex"))
-setMethod("getPartitionIndex", signature("Partitions", "NodeId"), function(partitions, nodeId) {
-  return(which(unlist(lapply(partitions, function(x) id(nodeId) %in% getNodeIds(x)))))
+setGeneric("getPartitionIndex", function(partitions, node) standardGeneric("getPartitionIndex"))
+setMethod("getPartitionIndex", signature("Partitions", "NodeId"), function(partitions, node) {
+  return(which(unlist(lapply(partitions, function(x) id(node) %in% getNodeIds(x)))))
+})
+setMethod("getPartitionIndex", signature("Partitions", "Node"), function(partitions, node) {
+  return(getPartitionIndex(partitions, id(node)))
+})
+setMethod("getPartitionIndex", signature("Partitions", "character"), function(partitions, node) {
+  return(getPartitionIndex(partitions, NodeId(node)))
 })

tests/testthat/test-kpartite-network.R

@@ -9,24 +9,27 @@ test_that("k-partite networks can be created", {
   nodeC <- Node(
     id = NodeId('C')
   )
+  nodeD <- Node(
+    id = NodeId('D')
+  )
 
   # Create links
   link1 <- Link(source = nodeA, target = nodeB, color = 1, weight = 10)
-  link2 <- Link(source = nodeB, target = nodeC, color = 2, weight = 20)
-  link3 <- Link(source = nodeC, target = nodeA, color = 3, weight = 30)
+  link2 <- Link(source = nodeB, target = nodeA, color = 2, weight = 20)
+  link3 <- Link(source = nodeC, target = nodeD, color = 3, weight = 30)
 
   # Create partitions
-  partition1 <- Partition(list(nodeA, nodeB))
-  partition2 <- Partition(nodeC)
+  partition1 <- Partition(list(nodeA, nodeC))
+  partition2 <- Partition(list(nodeB, nodeD))
 
   # Create k-partite network
   bpnet <- KPartiteNetwork(
     links = LinkList(list(link1, link2, link3)),
-    nodes = NodeList(list(nodeA, nodeB, nodeC)),
+    nodes = NodeList(list(nodeA, nodeB, nodeC, nodeD)),
     partitions = Partitions(list(partition1, partition2))
   )
 
-  expect_equal(getNodes(bpnet), NodeList(c(nodeA, nodeB, nodeC)))
+  expect_equal(getNodes(bpnet), NodeList(c(nodeA, nodeB, nodeC, nodeD)))
   expect_equal(getLinks(bpnet), LinkList(c(link1, link2, link3)))
   expect_equal(getLinkColorScheme(bpnet), 'none')
 
@@ -44,21 +47,24 @@ test_that("k-partite networks cannot be created from nonsensical inputs", {
   nodeC <- Node(
     id = NodeId('C')
   )
+  nodeD <- Node(
+    id = NodeId('D')
+  )
 
   # Create links
   link1 <- Link(source = nodeA, target = nodeB, color = 1, weight = 10)
-  link2 <- Link(source = nodeB, target = nodeC, color = 2, weight = 20)
-  link3 <- Link(source = nodeC, target = nodeA, color = 3, weight = 30) 
+  link2 <- Link(source = nodeB, target = nodeA, color = 2, weight = 20)
+  link3 <- Link(source = nodeC, target = nodeD, color = 3, weight = 30) 
 
   # Create columns
   partition1 <- Partition(list(nodeA, nodeB, nodeC))
-  partition2 <- Partition(nodeC)
+  partition2 <- Partition(list(nodeB, nodeD))
 
 
   # Nodes can't be in both columns
   expect_error(KPartiteNetwork(
     links = LinkList(list(link1, link2, link3)),
-    nodes = NodeList(list(nodeA, nodeB, nodeC)),
+    nodes = NodeList(list(nodeA, nodeB, nodeC, nodeD)),
     partitions = list(partition1, partition2)
   ))
 
@@ -68,9 +74,24 @@ test_that("k-partite networks cannot be created from nonsensical inputs", {
   expect_error(KPartiteNetwork(
     links = LinkList(c(link1, link2, link3)),
     nodes = NodeList(c(nodeA, nodeB, nodeC)),
-    partitions = list(partition1IDs, partition2IDs)
+    partitions = list(partition1, partition2)
   ))
 
+  # No links within a partition
+  partition1 <- Partition(list(nodeA, nodeB))
+  partition2 <- Partition(list(nodeC, nodeD))
+  link4 <- Link(source = nodeA, target = nodeC, color = 1, weight = 10)
+  expect_error(KPartiteNetwork(
+    links = LinkList(c(link1, link2, link3, link4)),
+    nodes = NodeList(c(nodeA, nodeB, nodeC)),
+    partitions = list(partition1, partition2)
+  ))
+
+  # no partitions specified
+  expect_error(KPartiteNetwork(
+    links = LinkList(c(link1, link2, link3)),
+    nodes = NodeList(c(nodeA, nodeB, nodeC))
+  ))
 })
 
 test_that("toJSON works for k-partite networks", {
@@ -84,51 +105,46 @@ test_that("toJSON works for k-partite networks", {
   nodeC <- Node(
     id = NodeId('C')
   )
+  nodeD <- Node(
+    id = NodeId('D')
+  )
 
   # Create some links
   link1 <- Link(source = nodeA, target = nodeB, weight = 10)
-  link2 <- Link(source = nodeB, target = nodeC, weight = 20)
-  link3 <- Link(source = nodeC, target = nodeA, weight = 30)
+  link2 <- Link(source = nodeB, target = nodeA, weight = 20)
+  link3 <- Link(source = nodeC, target = nodeD, weight = 30)
 
-  # Create the network w a single default partition
-  net <- KPartiteNetwork(links = LinkList(c(link1, link2, link3)), nodes = NodeList(c(nodeA, nodeB, nodeC)))
-  json <- veupathUtils::toJSON(net)
-  jsonList <- jsonlite::fromJSON(json)
-  expect_equal(jsonList$network$data$links$source, c('A','B','C'))
-  expect_equal(jsonList$network$data$links$target, c('B','C','A'))
-  expect_equal(jsonList$network$data$links$weight, c(10,20,30))
-  expect_equal(jsonList$network$data$nodes$id, c('A','B','C'))
-  expect_equal(as.list(jsonList$network$data$partitions), list('A','B','C'))
-  expect_equal(length(jsonList$network$config$variables), 0)
-
-  # Create partitions
-  partition1 <- Partition(list(nodeA, nodeB))
-  partition2 <- Partition(nodeC)
-
-  # Create k-partite network
-  bpnet <- KPartiteNetwork(
-    links = LinkList(list(link1, link2, link3)),
-    nodes = NodeList(list(nodeA, nodeB, nodeC)),
-    partitions = Partitions(list(partition1, partition2))
+  # Create the network
+  net <- KPartiteNetwork(
+    links = LinkList(c(link1, link2, link3)), 
+    nodes = NodeList(c(nodeA, nodeB, nodeC, nodeD)),
+    partitions = Partitions(list(Partition(list(nodeA, nodeC)), Partition(list(nodeB, nodeD))))
   )
-  json <- veupathUtils::toJSON(bpnet)
+  json <- veupathUtils::toJSON(net)
   jsonList <- jsonlite::fromJSON(json)
   expect_equal(jsonList$network$data$links$source, c('A','B','C'))
-  expect_equal(jsonList$network$data$links$target, c('B','C','A'))
+  expect_equal(jsonList$network$data$links$target, c('B','A','D'))
   expect_equal(jsonList$network$data$links$weight, c(10,20,30))
-  expect_equal(jsonList$network$data$nodes$id, c('A','B','C'))
-  expect_equal(jsonList$network$data$partitions, list(c('A','B'), c('C')))
+  expect_equal(jsonList$network$data$nodes$id, c('A','B','C','D'))
+  expect_equal(list(jsonList$network$data$partitions[1,],jsonList$network$data$partitions[2,]), list(c('A','C'), c('B','D')))
   expect_equal(length(jsonList$network$config$variables), 0)
 })
 
 test_that("we can build a KPartiteNetwork from an edgeList data.frame", {
   edgeList <- data.frame(
     source = c('a', 'b', 'c'),
-    target = c('b', 'c', 'a')
+    target = c('b', 'a', 'd')
   )
-  net <- KPartiteNetwork(object = edgeList)
-  expect_equal(getNodes(net), NodeList(c(Node('a'), Node('b'), Node('c'))))
-  expect_equal(getLinks(net), LinkList(c(Link(source = Node('a'), target = Node('b')), Link(source = Node('b'), target = Node('c')), Link(source = Node('c'), target = Node('a')))))
-  expect_equal(partitions(net), Partitions(list(Partition(list(Node('a'), Node('b'), Node('c'))))))
+  net <- KPartiteNetwork(
+    object = edgeList, 
+    partitions = Partitions(list(
+      Partition(list(Node('a'), Node('c'))), 
+      Partition(list(Node('b'), Node('d')))
+    ))
+  )
+
+  expect_equal(getNodes(net), NodeList(c(Node('a'), Node('b'), Node('c'), Node('d'))))
+  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

@@ -200,19 +200,6 @@ test_that("we can build a Network from an edgeList data.frame", {
   expect_equal(getLinks(net)[[3]]@weight, 3)
   expect_equal(getLinkColorScheme(net), 'none')
 
-  #w a color column
-  edgeList <- data.frame(
-    source = c('a', 'b', 'c'),
-    target = c('b', 'c', 'a'),
-    color = c("red", "green", "blue")
-  )
-  net <- Network(object = edgeList)
-  expect_equal(getNodes(net), NodeList(c(Node('a'), Node('b'), Node('c'))))
-  expect_equal(getLinks(net)[[1]]@color, "red")
-  expect_equal(getLinks(net)[[2]]@color, "green")
-  expect_equal(getLinks(net)[[3]]@color, "blue")
-  expect_equal(getLinkColorScheme(net), 'none')
-
   #w a color scheme
   edgeList <- data.frame(
     source = c('a', 'b', 'c'),