From f296876f18f5309d5d9c12990bdcfc2c72cd8138 Mon Sep 17 00:00:00 2001 From: Danielle Callan Date: Tue, 30 Jan 2024 13:19:36 -0500 Subject: [PATCH] get tests passing again --- R/class-KPartiteNetwork.R | 19 ++--- R/class-Link.R | 2 + R/class-Partitions.R | 14 +++- tests/testthat/test-kpartite-network.R | 100 ++++++++++++++----------- tests/testthat/test-network.R | 13 ---- 5 files changed, 80 insertions(+), 68 deletions(-) diff --git a/R/class-KPartiteNetwork.R b/R/class-KPartiteNetwork.R index f20ac96..3797ab7 100644 --- a/R/class-KPartiteNetwork.R +++ b/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 diff --git a/R/class-Link.R b/R/class-Link.R index f6894df..6f5bc80 100644 --- a/R/class-Link.R +++ b/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')) } diff --git a/R/class-Partitions.R b/R/class-Partitions.R index 45bb913..2759d11 100644 --- a/R/class-Partitions.R +++ b/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))) }) \ No newline at end of file diff --git a/tests/testthat/test-kpartite-network.R b/tests/testthat/test-kpartite-network.R index a31ecb4..5b94e04 100644 --- a/tests/testthat/test-kpartite-network.R +++ b/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') }) \ No newline at end of file diff --git a/tests/testthat/test-network.R b/tests/testthat/test-network.R index 665aac3..63a359c 100644 --- a/tests/testthat/test-network.R +++ b/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'),