diff --git a/NEWS b/NEWS index 3339d9d..0e96cf8 100644 --- a/NEWS +++ b/NEWS @@ -2,6 +2,7 @@ CancerEvolutionVisualization 1.0.0 2022-09-01 (Dan Knight) ADDED * Documentation for default colour scheme +* Checks for valid tree structure (root node) UPDATE * Fixed discrepancies between documentation and code diff --git a/R/prep.tree.R b/R/prep.tree.R index adce858..06db3ad 100644 --- a/R/prep.tree.R +++ b/R/prep.tree.R @@ -9,6 +9,9 @@ prep.tree <- function( stop('No parent column provided'); } + # Error on invalid tree structure + get.root.node(tree.df); + if ('angle' %in% colnames(tree.df)) { message(paste( 'Overriding branch angles will be supported in a future version.', @@ -143,6 +146,19 @@ check.parent.values <- function(node.names, parent.col) { )); } +get.root.node <- function(tree) { + valid.values <- as.character(c(-1, 0)); + candidates <- which(is.na(tree$parent) | tree$parent %in% valid.values); + + if (length(candidates) > 1) { + stop('More than one root node detected.'); + } else if (length(candidates) == 0) { + stop('No root node provided.'); + } + + return(candidates); + } + get.y.axis.position <- function(tree.colnames) { num.branch.length.cols <- length(get.branch.length.colnames(tree.colnames)); diff --git a/tests/testthat/test-prep.tree.R b/tests/testthat/test-prep.tree.R index 7263e7d..f75a86d 100644 --- a/tests/testthat/test-prep.tree.R +++ b/tests/testthat/test-prep.tree.R @@ -206,6 +206,54 @@ test_that( expect_true(check.parent.values(node.names, parents)); }); +test_that( + 'get.root.node handles valid NA root', { + parent <- c(2, NA, 1); + expected.root <- which(is.na(parent)); + + tree <- data.frame(parent = parent); + root <- get.root.node(tree); + + expect_equal(root, expected.root); + }); + +test_that( + 'get.root.node handles valid -1 root', { + parent <- c(2, -1, 1); + expected.root <- which(parent == -1); + + tree <- data.frame(parent = parent); + root <- get.root.node(tree); + + expect_equal(root, expected.root); + }); + +test_that( + 'get.root.node handles valid 0 root', { + parent <- c(2, 0, 1); + expected.root <- which(parent == 0); + + tree <- data.frame(parent = parent); + root <- get.root.node(tree); + + expect_equal(root, expected.root); + }); + +test_that( + 'get.root.node handles multiple root nodes', { + root.parent <- -1; + tree <- data.frame(parent = rep(root.parent, 2)); + + expect_error(get.root.node(tree), regexp = 'root') + }); + +test_that( + 'get.root.node handles a missing root node', { + tree <- data.frame(parent = 1:3); + + expect_error(get.root.node(tree), regexp = 'root'); + }); + test_that( 'get.y.axis.position handles a single branch length column', { valid.colname <- 'length1';