From 945b0cc15639e3fa0850ade0d380f02ccf2c761b Mon Sep 17 00:00:00 2001 From: J Wokaty Date: Tue, 30 Apr 2024 11:32:37 -0400 Subject: [PATCH 1/3] bump x.y.z version to even y prior to creation of RELEASE_3_19 branch --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index f1fcb2e2..70d668cc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: miaViz Title: Microbiome Analysis Plotting and Visualization -Version: 1.11.2 +Version: 1.12.0 Authors@R: c(person(given = "Tuomas", family = "Borman", role = c("aut", "cre"), email = "tuomas.v.borman@utu.fi", From 47ad304f90e56cadc9087f8cab3c0ef6bf3e5a28 Mon Sep 17 00:00:00 2001 From: J Wokaty Date: Tue, 30 Apr 2024 11:32:37 -0400 Subject: [PATCH 2/3] bump x.y.z version to odd y following creation of RELEASE_3_19 branch --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 70d668cc..d32e6234 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: miaViz Title: Microbiome Analysis Plotting and Visualization -Version: 1.12.0 +Version: 1.13.0 Authors@R: c(person(given = "Tuomas", family = "Borman", role = c("aut", "cre"), email = "tuomas.v.borman@utu.fi", From 9ed45eb71e0ae0f496c25965581b5f7e3753191f Mon Sep 17 00:00:00 2001 From: Tuomas Borman <60338854+TuomasBorman@users.noreply.github.com> Date: Sat, 18 May 2024 13:01:42 +0300 Subject: [PATCH 3/3] Fix plot*Tree (#124) --- DESCRIPTION | 2 +- NAMESPACE | 1 + NEWS | 3 + R/plotTree.R | 125 +++++++++++++++++++++----------- tests/testthat/test-2plotTree.R | 10 +-- 5 files changed, 94 insertions(+), 47 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 87c007b5..770648ef 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: miaViz Title: Microbiome Analysis Plotting and Visualization -Version: 1.13.0 +Version: 1.13.1 Authors@R: c(person(given = "Tuomas", family = "Borman", role = c("aut", "cre"), email = "tuomas.v.borman@utu.fi", diff --git a/NAMESPACE b/NAMESPACE index 768d624d..910afe9b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -57,6 +57,7 @@ importFrom(SummarizedExperiment,assay) importFrom(SummarizedExperiment,colData) importFrom(SummarizedExperiment,rowData) importFrom(ape,as.phylo) +importFrom(ape,drop.tip) importFrom(ape,keep.tip) importFrom(ape,rotateConstr) importFrom(dplyr,"%>%") diff --git a/NEWS b/NEWS index 344736e8..b584ddb0 100644 --- a/NEWS +++ b/NEWS @@ -24,3 +24,6 @@ Changes in version 1.9.x Changes in version 1.11.x + replace addTaxonomyTree with addHierarchyTree after renaming in mia package + +Changes in version 1.13.x ++ plot*Tree: bugfix, ununique nodes diff --git a/R/plotTree.R b/R/plotTree.R index 0aea3015..d1fc0d52 100644 --- a/R/plotTree.R +++ b/R/plotTree.R @@ -407,11 +407,12 @@ setMethod("plotRowTree", signature = c(object = "TreeSummarizedExperiment"), abbr_label = abbr_label, add_legend = add_legend) # - tree_out <- .get_trimed_object_and_tree(object, - tree_name = tree_name, - type = type, - relabel = relabel_tree, - order = order_tree) + tree_out <- .get_object_and_trimmed_tree( + object, + tree_name = tree_name, + type = type, + relabel = relabel_tree, + order = order_tree) object <- tree_out$object tree <- tree_out$tree tree_data <- .get_tree_data(tree) @@ -477,60 +478,103 @@ setMethod("plotRowTree", signature = c(object = "TreeSummarizedExperiment"), ...) } - -#' @importFrom ape keep.tip as.phylo +#' @importFrom ape keep.tip as.phylo drop.tip #' @importFrom tidytree as_tibble -.get_trimed_object_and_tree <- function(object, - tree_name = "phylo", - type = c("row","column"), - relabel = FALSE, - order = FALSE){ +.get_object_and_trimmed_tree <- function( + object, + tree_name = "phylo", + type = c("row","column"), + relabel = FALSE, + order = FALSE){ + # Check type type <- match.arg(type) + # Get correct functions based on the margin/direction tree_FUN <- switch(type, row = rowTree, column = colTree, stop(".")) links_FUN <- switch(type, row = rowLinks, column = colLinks, stop(".")) dimnames_FUN <- switch(type, row = rownames, column = colnames, stop(".")) + add_names_FUN <- switch( + type, row = `rownames<-`, column = `colnames<-`, stop(".")) + # Check that the tree is compatible with the data, i.e., rows are matched + # with the tree. + links_FUN <- switch(type, row = rowLinks, column = colLinks, stop(".")) + links <- links_FUN(object) + ind <- links[["whichTree"]] == tree_name + if( all(!ind) ){ + stop("Tree does not have any ", type, "s to plot.", call. = FALSE) + } + # Get only those rows/columns that are found from the tree + if( type == "row" ){ + object <- object[ind, ] + } else{ + object <- object[, ind] + } + # Get tree and links tree <- tree_FUN(object, tree_name) links <- links_FUN(object) - # + + # Remove those tips that are not leaves tips <- sort(setdiff(tree$edge[, 2], tree$edge[, 1])) drop_tip <- tips[!(tips %in% unique(links$nodeNum[links$isLeaf]))] oldTree <- tree - newTree <- ape::drop.tip(oldTree, tip = drop_tip, collapse.singles = FALSE) + newTree <- drop.tip(oldTree, tip = drop_tip, collapse.singles = FALSE) + # Add alias labels to tree track <- trackNode(oldTree) - track <- ape::drop.tip(track, tip = drop_tip, collapse.singles = FALSE) - # + track <- drop.tip(track, tip = drop_tip, collapse.singles = FALSE) + # Link tree with alias labels oldAlias <- links$nodeLab_alias newNode <- convertNode(tree = track, node = oldAlias) newAlias <- convertNode(tree = newTree, node = newNode) - if(type == "row"){ - object <- changeTree(x = object, rowTree = newTree, rowNodeLab = newAlias) + # Change the tree with trimmed tree and add aliases as node labels + if( type == "row" ){ + object <- changeTree( + x = object, rowTree = newTree, rowNodeLab = newAlias) } else { - object <- changeTree(x = object, colTree = newTree, colNodeLab = newAlias) + object <- changeTree( + x = object, colTree = newTree, colNodeLab = newAlias) } - # + + # Get tree, links and row/colnames tree <- tree_FUN(object) links <- links_FUN(object) dimnames <- dimnames_FUN(object) - # - tree_data <- as_tibble(newTree) + # Get tree as table and get which node represent which row/col + tree_data <- as_tibble(tree) m <- match(links$nodeNum,tree_data$node) node_labels <- tree_data$label[m] - if(relabel || - !all(node_labels %in% dimnames)){ - new_node_labels <- getTaxonomyLabels(object, with_rank = TRUE, - resolve_loops = TRUE) - if(type == "row"){ - rownames(object) <- new_node_labels - } else { - colnames(object) <- new_node_labels - } - tree_data$label[m] <- new_node_labels - tree <- as.phylo(tree_data) + # If user wants to rename rows/cols or if some nodes cannot be found from + # rows/cols + if( relabel || !all(node_labels %in% dimnames) ){ + # Rename rows/cols + new_node_labels <- getTaxonomyLabels( + object, with_rank = TRUE, resolve_loops = TRUE) + object <- add_names_FUN(object, new_node_labels) + } + # Check if there are rows/cols that are ununique. If there are, make them + # unique. + if( anyDuplicated(rownames(object)) ){ + warning( + "Data includes ununique ", type, "s. Making them unique.", + call. = FALSE) + object <- add_names_FUN(object, make.unique(dimnames_FUN(object))) + } + # Rename labels of tree with row/colnames + tree_data$label[m] <- dimnames_FUN(object) + # Check if there are nodes that are not unique + if( anyDuplicated(tree_data$label[-m]) ){ + warning( + "Tree includes ununique nodes. Making them unique.", call. = FALSE) + tree_data$label[-m] <- make.unique( tree_data$label[-m] ) + } + + # Convert tree data back to tree-format + tree <- as.phylo(tree_data) + # If specified, order the tree based on alphabetical order if(order){ tree <- .order_tree(tree) } - list(object = object, tree = tree) + res <- list(object = object, tree = tree) + return(res) } #' @importFrom tidytree child @@ -564,7 +608,6 @@ setMethod("plotRowTree", signature = c(object = "TreeSummarizedExperiment"), } ################################################################################ -## TODO refactor the next three functions into one .remove_taxonomic_level_from_labels <- function(labels){ for(rank in TAXONOMY_RANKS){ @@ -761,7 +804,6 @@ setMethod("plotRowTree", signature = c(object = "TreeSummarizedExperiment"), show_highlight_label = show_highlight_label)) } -## TODO END ################################################################################ #' @importFrom tibble tibble @@ -870,7 +912,7 @@ NODE_VARIABLES <- c("node_colour_by", "node_shape_by", "node_size_by") feature_info <- feature_info %>% mutate(label = rownames(se)) %>% relocate("label") - tree_data <- .merge_tree_vis_data(tree_data, feature_info) + tree_data <- .merge_tree_vis_data(tree_data, feature_info, se) } tree_data <- .merge_tip_node_tree_data(tree_data) } @@ -880,7 +922,7 @@ NODE_VARIABLES <- c("node_colour_by", "node_shape_by", "node_size_by") other <- other %>% mutate(label = rownames(se)) %>% relocate("label") - tree_data <- .merge_tree_vis_data(tree_data, other) + tree_data <- .merge_tree_vis_data(tree_data, other, se) } } return(list(df = tree_data, @@ -939,12 +981,13 @@ NODE_VARIABLES <- c("node_colour_by", "node_shape_by", "node_size_by") tree_data[match(bak_o,tree_data$node),] } -.merge_tree_vis_data <- function(tree_data, feature_info){ +.merge_tree_vis_data <- function(tree_data, feature_info, tse){ if(anyDuplicated(tree_data$label) || anyDuplicated(feature_info$label)){ - stop(".") + stop("Tree is not compatible with the data.", call. = FALSE) } - tree_data %>% + tree_data <- tree_data %>% dplyr::left_join(feature_info, by = "label") + return(tree_data) } # due to a bug in ggtree/tidytree the treedata object needs to be constructed diff --git a/tests/testthat/test-2plotTree.R b/tests/testthat/test-2plotTree.R index 50b85881..be96472c 100644 --- a/tests/testthat/test-2plotTree.R +++ b/tests/testthat/test-2plotTree.R @@ -43,16 +43,16 @@ test_that("plot tree", { # data(GlobalPatterns) x <- GlobalPatterns - # .get_trimed_object_and_tree - expect_error(miaViz:::.get_trimed_object_and_tree(), + # .get_object_and_trimmed_tree + expect_error(miaViz:::.get_object_and_trimmed_tree(), 'argument "object" is missing') - actual <- miaViz:::.get_trimed_object_and_tree(x["549322",]) + actual <- miaViz:::.get_object_and_trimmed_tree(x["549322",]) expect_s3_class(actual$tree,"phylo") expect_s4_class(actual$object,"TreeSummarizedExperiment") expect_equal(unique(actual$tree$tip.label), c("549322")) - actual <- miaViz:::.get_trimed_object_and_tree(x) + actual <- miaViz:::.get_object_and_trimmed_tree(x) expect_equal(actual$tree$tip.label, rownames(x)) - actual <- miaViz:::.get_trimed_object_and_tree(x, relabel = TRUE) + actual <- miaViz:::.get_object_and_trimmed_tree(x, relabel = TRUE) expect_equal(actual$tree$tip.label[1L], "Class:Thermoprotei") # library(scater)